X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FPageEntity.hs;h=8f63bbaad3b9c6f68748530ccc261cd68c0bb5d2;hb=443af4d3304139bb2187a0c726327b9c05829810;hp=b894088913f5b4d49a6b91d655fcc9a4cc91dbab;hpb=f53425414d1861f105a3063cdbb4bf96cdc755a2;p=Rakka.git diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index b894088..8f63bba 100644 --- a/Rakka/Resource/PageEntity.hs +++ b/Rakka/Resource/PageEntity.hs @@ -20,6 +20,7 @@ import Rakka.Storage import Rakka.SystemConfig import Rakka.Wiki.Engine import System.FilePath +import Text.XML.HXT.Arrow.Namespace import Text.XML.HXT.Arrow.WriteDocument import Text.XML.HXT.Arrow.XmlArrow import Text.XML.HXT.Arrow.XmlIOStateArrow @@ -37,11 +38,11 @@ fallbackPageEntity env path = return $ Just $ ResourceDef { resUsesNativeThread = False , resIsGreedy = True - , resGet = Just $ handleGet env (toPageName path) + , resGet = Just $ handleGet env (toPageName path) , resHead = Nothing , resPost = Nothing - , resPut = Just $ handlePut env (toPageName path) - , resDelete = Nothing + , resPut = Just $ handlePut env (toPageName path) + , resDelete = Just $ handleDelete env (toPageName path) } where toPageName :: [String] -> PageName @@ -53,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 @@ -193,6 +192,8 @@ entityToXHTML env ) ) ) + >>> + uniqueNamespacesFromDeclAndQNames ) ) -<< page @@ -298,12 +299,22 @@ notFoundToXHTML env ) ) ) + >>> + uniqueNamespacesFromDeclAndQNames ) ) -<< pageNotFound handlePut :: Environment -> PageName -> Resource () handlePut env name - = runXmlA env "rakka-page-1.0.rng" $ proc tree - -> do page <- parseXmlizedPage -< (name, tree) - status <- putPageA (envStorage env) -< page - returnA -< setStatus status + = do userID <- getUserID env + runXmlA env "rakka-page-1.0.rng" $ proc tree + -> do page <- parseXmlizedPage -< (name, tree) + status <- putPageA (envStorage env) -< (userID, page) + returnA -< setStatus status + + +handleDelete :: Environment -> PageName -> Resource () +handleDelete env name + = do userID <- getUserID env + status <- deletePage (envStorage env) userID name + setStatus status