X-Git-Url: http://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FResource%2FPageEntity.hs;h=1ad3ffaf5c782b6b543497ec3b682ba600c0a93f;hb=044a917ed3908780479b759ac772e1545616c7fc;hp=b894088913f5b4d49a6b91d655fcc9a4cc91dbab;hpb=f53425414d1861f105a3063cdbb4bf96cdc755a2;p=Rakka.git diff --git a/Rakka/Resource/PageEntity.hs b/Rakka/Resource/PageEntity.hs index b894088..1ad3ffa 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,6 +299,8 @@ notFoundToXHTML env ) ) ) + >>> + uniqueNamespacesFromDeclAndQNames ) ) -<< pageNotFound @@ -307,3 +310,9 @@ handlePut env name -> do page <- parseXmlizedPage -< (name, tree) status <- putPageA (envStorage env) -< page returnA -< setStatus status + + +handleDelete :: Environment -> PageName -> Resource () +handleDelete env name + = do status <- deletePage (envStorage env) name + setStatus status