X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FObject.hs;h=3a98b1e262810fdb403ac69c81fb7bb2fda9a7a6;hb=42f51754dea02201aececaacbf194d714cd58aaf;hp=af0d9b7604da54602e89e7d6ef4e25a749947c48;hpb=885faf1cabc3f79c90e1885268e2a9138b1ddefb;p=Rakka.git diff --git a/Rakka/Resource/Object.hs b/Rakka/Resource/Object.hs index af0d9b7..3a98b1e 100644 --- a/Rakka/Resource/Object.hs +++ b/Rakka/Resource/Object.hs @@ -1,46 +1,45 @@ +{-# LANGUAGE + UnicodeSyntax + #-} module Rakka.Resource.Object ( resObject ) where - +import qualified Codec.Binary.UTF8.String as UTF8 +import Control.Monad.Unicode +import qualified Data.Text as T import Network.HTTP.Lucu -import Network.HTTP.Lucu.Utils +import Prelude.Unicode import Rakka.Environment import Rakka.Page import Rakka.Storage import Rakka.SystemConfig -import System.FilePath -import System.Time - +import System.FilePath.Posix -resObject :: Environment -> ResourceDef +resObject ∷ Environment → ResourceDef resObject env = ResourceDef { resUsesNativeThread = False , resIsGreedy = True - , resGet = Just $ getPathInfo >>= handleGet env . toPageName + , resGet = Just $ getPathInfo ≫= handleGet env ∘ toPageName , resHead = Nothing , resPost = Nothing , resPut = Nothing , resDelete = Nothing } where - toPageName :: [String] -> PageName - toPageName = decodePageName . dropExtension . joinWith "/" - + toPageName ∷ [String] → PageName + toPageName = T.pack ∘ UTF8.decodeString . joinPath handleGet :: Environment -> PageName -> Resource () handleGet env name - = do pageM <- getPage (envStorage 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 env entity + Nothing -> foundNoEntity Nothing + Just page -> if isEntity page then + handleGetEntity page + else + handleRedirect env page {- @@ -49,7 +48,7 @@ handleGet env name -} handleRedirect :: Environment -> Page -> Resource () handleRedirect env redir - = do BaseURI baseURI <- getSysConf (envSysConf env) (BaseURI undefined) + = do BaseURI baseURI <- getSysConf (envSysConf env) redirect Found (mkObjectURI baseURI $ redirName redir) @@ -59,13 +58,11 @@ handleRedirect env redir ... -} -handleGetEntity :: Environment -> Page -> Resource () -handleGetEntity env page - = do let lastMod = toClockTime $ pageLastMod page - - case pageRevision page of - Nothing -> foundTimeStamp lastMod - Just rev -> foundEntity (strongETag $ show rev) lastMod +handleGetEntity :: Page -> Resource () +handleGetEntity page + = do case entityRevision page of + 0 -> foundTimeStamp (entityLastMod page) -- 0 はデフォルトページ + rev -> foundEntity (strongETag $ show rev) (entityLastMod page) - setContentType (pageType page) - outputLBS (pageContent page) + setContentType (entityType page) + outputLBS (entityContent page)