From bf15724655b75bf1b8f0fdabb111c158a91680a8 Mon Sep 17 00:00:00 2001 From: pho Date: Sun, 6 Jan 2008 18:05:24 +0900 Subject: [PATCH] dropped the concept of page file name darcs-hash:20080106090524-62b54-309d7c5da75ecf1802c8af41bb206e8b34822800.gz --- Rakka/Page.hs | 30 ++---------------------------- Rakka/Resource/Object.hs | 16 +++++----------- Rakka/Resource/PageEntity.hs | 12 +++++------- Rakka/Storage/DefaultPage.hs | 22 ++++++++++------------ Rakka/Storage/Repos.hs | 3 --- Rakka/Wiki/Engine.hs | 10 +++++----- 6 files changed, 27 insertions(+), 66 deletions(-) diff --git a/Rakka/Page.hs b/Rakka/Page.hs index f701d92..9883b57 100644 --- 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 { 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 00ebc28..b46a86a 100644 --- 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 59753d7..21d38c9 100644 --- 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 bba2279..06b4036 100644 --- 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 f8ac5dd..c9b913c 100644 --- 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 b475f9c..72effb3 100644 --- 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 - -- foo.zip + -- + -- application/zip + -- returnA -< [ Paragraph [ Anchor [("href", show dataURI)] - [Text (fromMaybe (defaultFileName pType pName) pFileName)] + [Text (show pType)] ] ] else -- 2.40.0