dropped the concept of page file name

darcs-hash:20080106090524-62b54-309d7c5da75ecf1802c8af41bb206e8b34822800.gz

diff --git a/Rakka/Page.hs b/Rakka/Page.hs
index f701d92078e757a0ada421d7d54f33e8d4d2b609..9883b576f9be232abb5a715735c5c9109c004d6a 100644 (file)
--- a/Rakka/Page.hs
+++ b/Rakka/Page.hs
@@ -15,9 +15,6 @@ module Rakka.Page
     , encodePageName
     , decodePageName
 
-    , entityFileName'
-    , defaultFileName
-
     , mkPageURI
     , mkPageFragmentURI
     , mkObjectURI
@@ -71,7 +68,6 @@ data Page
         entityName       :: !PageName
       , entityType       :: !MIMEType
       , entityLanguage   :: !(Maybe LanguageTag)
-      , entityFileName   :: !(Maybe String)
       , entityIsTheme    :: !Bool     -- text/css 以外では無意味
       , entityIsFeed     :: !Bool     -- text/x-rakka 以外では無意味
       , entityIsLocked   :: !Bool
@@ -101,8 +97,8 @@ isRedirect _                       = False
 
 
 isEntity :: Page -> Bool
-isEntity (Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) = True
-isEntity _                                      = False
+isEntity (Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _) = True
+isEntity _                                    = False
 
 
 pageName :: Page -> PageName
@@ -151,21 +147,6 @@ encodeFragment :: String -> String
 encodeFragment = escapeURIString isSafeChar . UTF8.encodeString
 
 
-entityFileName' :: Page -> String
-entityFileName' page
-    = fromMaybe (defaultFileName (entityType page) (entityName page)) (entityFileName page)
-
-
-defaultFileName :: MIMEType -> PageName -> String
-defaultFileName pType pName
-    = let baseName = takeFileName pName
-      in 
-        case pType of
-          MIMEType "text" "x-rakka" _ -> baseName <.> "rakka"
-          MIMEType "text" "css"     _ -> baseName <.> "css"
-          _                           -> baseName
-
-
 mkPageURI :: URI -> PageName -> URI
 mkPageURI baseURI name
     = baseURI {
@@ -214,7 +195,6 @@ mkRakkaURI name = URI {
   <page name="Foo/Bar"
         type="text/x-rakka"
         lang="ja"            -- 存在しない場合もある
-        fileName="bar.rakka" -- 存在しない場合もある
         isTheme="no"         -- text/css の場合のみ存在
         isFeed="no"          -- text/x-rakka の場合のみ存在
         isLocked="no"
@@ -276,10 +256,6 @@ xmlizePage
                               Just x  -> sattr "lang" x
                               Nothing -> none
                           )
-                       += ( case entityFileName page of
-                              Just x  -> sattr "fileName" x
-                              Nothing -> none
-                          )
                        += ( case entityType page of
                               MIMEType "text" "css" _
                                   -> sattr "isTheme" (yesOrNo $ entityIsTheme page)
@@ -342,7 +318,6 @@ parseEntity
           mimeTypeStr <- withDefault (getXPathTreesInDoc "/page/@type/text()" >>> getText) "" -< tree
 
           lang     <- maybeA (getXPathTreesInDoc "/page/@lang/text()"     >>> getText) -< tree
-          fileName <- maybeA (getXPathTreesInDoc "/page/@filename/text()" >>> getText) -< tree
 
           isTheme  <- (withDefault (getXPathTreesInDoc "/page/@isTheme/text()" >>> getText) "no"
                        >>> parseYesOrNo) -< tree
@@ -384,7 +359,6 @@ parseEntity
                         entityName       = name
                       , entityType       = mimeType
                       , entityLanguage   = lang
-                      , entityFileName   = fileName
                       , entityIsTheme    = isTheme
                       , entityIsFeed     = isFeed
                       , entityIsLocked   = isLocked

diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs
index 00ebc28e140a622e9d7560e66fb52afc7810adfa..b46a86a30a330bbdcdbb412f09def05d66c50d86 100644 (file)
--- a/Rakka/Resource/Object.hs
+++ b/Rakka/Resource/Object.hs
@@ -4,7 +4,6 @@ module Rakka.Resource.Object
     )
     where
 
-import           Data.ByteString.Char8 as C8
 import           Data.Maybe
 import           Network.HTTP.Lucu
 import           Network.HTTP.Lucu.Utils
@@ -34,14 +33,11 @@ handleGet :: Environment -> PageName -> Resource ()
 handleGet env name
     = do pageM <- getPage (envStorage env) name Nothing
          case pageM of
-           Nothing
-               -> foundNoEntity Nothing
-
-           Just redir@(Redirection _ _ _ _ _)
-               -> handleRedirect env redir
-
-           Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
-               -> handleGetEntity entity
+           Nothing   -> foundNoEntity Nothing
+           Just page -> if isEntity page then
+                            handleGetEntity page
+                        else
+                            handleRedirect env page
 
 
 {-
@@ -67,6 +63,4 @@ handleGetEntity page
            rev -> foundEntity (strongETag $ show rev) (entityLastMod page)
 
          setContentType (entityType page)
-         setHeader (C8.pack "Content-Disposition")
-                       (C8.pack $ "attachment; filename=" ++ quoteStr (entityFileName' page))
          outputLBS (entityContent page)

diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs
index 59753d7d5fd223ceaeab59453d15fa8dc87fdd29..21d38c99e1b29319ebd25198458e0afced23d3b6 100644 (file)
--- a/Rakka/Resource/PageEntity.hs
+++ b/Rakka/Resource/PageEntity.hs
@@ -54,14 +54,12 @@ handleGet env name
     = runIdempotentA $ proc ()
     -> do pageM <- getPageA (envStorage env) -< (name, Nothing)
           case pageM of
-            Nothing
-                -> handlePageNotFound env -< name
+            Nothing   -> handlePageNotFound env -< name
+            Just page -> if isEntity page then
+                             handleGetEntity env -< page
+                         else
+                             handleRedirect env -< page
 
-            Just redir@(Redirection _ _ _ _ _)
-                -> handleRedirect env -< redir
-
-            Just entity@(Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _)
-                -> handleGetEntity env -< entity
 
 {-
   HTTP/1.1 302 Found

diff --git a/Rakka/Storage/DefaultPage.hs b/Rakka/Storage/DefaultPage.hs
index bba22798d4597a15442ecf762517169d140ca76f..06b40361908ff39e1f2bf20b028d3a16fa0e8fe6 100644 (file)
--- a/Rakka/Storage/DefaultPage.hs
+++ b/Rakka/Storage/DefaultPage.hs
@@ -88,15 +88,13 @@ loadPageFileA
                     -< fpath
          page    <- parseXmlizedPage -< (name, tree)
 
-         case page of
-           Redirection _ _ _ _ _
-               -> returnA -< page {
-                     redirRevision = 0
-                   , redirLastMod  = lastMod
-                   }
-
-           Entity _ _ _ _ _ _ _ _ _ _ _ _ _ _ _
-               -> returnA -< page {
-                     entityRevision = 0
-                   , entityLastMod  = lastMod
-                   }
+         if isEntity page then
+             returnA -< page {
+                           entityRevision = 0
+                         , entityLastMod  = lastMod
+                         }
+           else
+             returnA -< page {
+                           redirRevision = 0
+                         , redirLastMod  = lastMod
+                         }

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index f8ac5ddcea7e9a3c587a5477a5c2c6762b936487..c9b913cb303844c1a7ee3ffa78896078120fd28d 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -127,7 +127,6 @@ loadPageInRepository repos name rev
                             entityName       = name
                           , entityType       = mimeType
                           , entityLanguage   = fmap chomp (lookup "rakka:lang" props)
-                          , entityFileName   = fmap chomp (lookup "rakka:fileName" props)
                           , entityIsTheme    = any ((== "rakka:isTheme") . fst) props
                           , entityIsFeed     = any ((== "rakka:isFeed") . fst) props
                           , entityIsLocked   = any ((== "rakka:isLocked") . fst) props
@@ -227,7 +226,6 @@ putPageIntoRepository repos page
           = do let path = mkPagePath name
                setNodeProp path "svn:mime-type"   (Just "application/x-rakka-redirection")
                setNodeProp path "rakka:lang"      Nothing
-               setNodeProp path "rakka:fileName"  Nothing
                setNodeProp path "rakka:isTheme"   Nothing
                setNodeProp path "rakka:isFeed"    Nothing
                setNodeProp path "rakka:isLocked"  Nothing
@@ -242,7 +240,6 @@ putPageIntoRepository repos page
           = do let path = mkPagePath name
                setNodeProp path "svn:mime-type"   ((Just . show . entityType) page)
                setNodeProp path "rakka:lang"      (entityLanguage page)
-               setNodeProp path "rakka:fileName"  (entityFileName page)
                setNodeProp path "rakka:isTheme"   (encodeFlag $ entityIsTheme page)
                setNodeProp path "rakka:isFeed"    (encodeFlag $ entityIsFeed page)
                setNodeProp path "rakka:isLocked"  (encodeFlag $ entityIsLocked page)

diff --git a/Rakka/Wiki/Engine.hs b/Rakka/Wiki/Engine.hs
index b475f9c04be3c3db3335f320bd011334a5eac16c..72effb3ed2414817ae7a4d09e6062082a657d06d 100644 (file)
--- a/Rakka/Wiki/Engine.hs
+++ b/Rakka/Wiki/Engine.hs
@@ -39,9 +39,7 @@ type InterpTable = Map String Interpreter
 wikifyPage :: (ArrowXml a, ArrowChoice a) => InterpTable -> a XmlTree WikiPage
 wikifyPage interpTable
     = proc tree
-    -> do pName      <- getXPathTreesInDoc "/page/@name/text()" >>> getText -< tree
-          pType      <- getXPathTreesInDoc "/page/@type/text()" >>> getText >>> arr read -< tree
-          pFileName  <- maybeA (getXPathTreesInDoc "/page/fileName/text()"   >>> getText) -< tree
+    -> do pType      <- getXPathTreesInDoc "/page/@type/text()" >>> getText >>> arr read -< tree
           textData   <- maybeA (getXPathTreesInDoc "/page/textData/text()"   >>> getText) -< tree
           base64Data <- maybeA (getXPathTreesInDoc "/page/binaryData/text()" >>> getText) -< tree
 
@@ -58,10 +56,12 @@ wikifyPage interpTable
                 -> returnA -< [ Paragraph [Image (Left $ fromJust dataURI) Nothing] ]
 
             _   -> if isJust dataURI then
-                       -- <a href="data:application/zip;base64,...">foo.zip</a>
+                       -- <a href="data:application/zip;base64,...">
+                       --   application/zip
+                       -- </a>
                        returnA -< [ Paragraph [ Anchor
                                                 [("href", show dataURI)]
-                                                [Text (fromMaybe (defaultFileName pType pName) pFileName)]
+                                                [Text (show pType)]
                                               ]
                                   ]
                    else