implemented page listing

[Rakka.git] / Rakka / Storage / Repos.hs

diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs
index 8430068922a7e1b8e98676e539dc28d8f1f45296..01f64c7a581889321f03f26c47170cff343164b1 100644 (file)
--- a/Rakka/Storage/Repos.hs
+++ b/Rakka/Storage/Repos.hs
@@ -1,5 +1,6 @@
 module Rakka.Storage.Repos
     ( findAllPagesInRevision
+    , getDirContentsInRevision
     , findChangedPagesAtRevision
     , loadPageInRepository
     , putPageIntoRepository
@@ -37,6 +38,11 @@ mkPagePath name
     = "/pages" </> encodePageName name <.> "page"
 
 
+mkDirPath :: PageName -> FilePath
+mkDirPath dir
+    = "/pages" </> encodePageName dir
+
+
 findAllPagesInRevision :: Repository -> RevNum -> IO (Set PageName)
 findAllPagesInRevision repos rev
     = do fs <- getRepositoryFS repos
@@ -68,6 +74,29 @@ findAllPagesInRevision repos rev
       decodePath = decodePageName . makeRelative root . dropExtension
 
 
+getDirContentsInRevision :: Repository -> PageName -> Maybe RevNum -> IO (Set PageName)
+getDirContentsInRevision repos dir rev
+    = do fs   <- getRepositoryFS repos
+         rev' <- case rev of
+                   Nothing -> getYoungestRev fs
+                   Just r  -> return r
+         withRevision fs rev'
+             $ do exists <- isDirectory path
+                  if exists then
+                      return . S.fromList =<< getDir'
+                    else
+                      return S.empty
+    where
+      path :: FilePath
+      path = mkDirPath dir
+
+      getDir' :: Rev [PageName]
+      getDir' = getDirEntries path >>= return . map entToName
+
+      entToName :: DirEntry -> PageName
+      entToName = (dir </>) . decodePageName . dropExtension . entName
+
+
 findChangedPagesAtRevision :: Repository -> RevNum -> IO (Set PageName)
 findChangedPagesAtRevision repos rev
     = do fs <- getRepositoryFS repos
@@ -93,11 +122,10 @@ loadPageInRepository repos name rev
                    Just r  -> return r
          withRevision fs rev'
              $ do exists <- isFile path
-                  case exists of
-                    True
-                        -> return . Just =<< loadPage'
-                    False
-                        -> return Nothing
+                  if exists then
+                      return . Just =<< loadPage'
+                    else
+                      return Nothing
     where
       path :: FilePath
       path = mkPagePath name
@@ -158,9 +186,13 @@ loadPageInRepository repos name rev
                lastMod <- getRevisionProp "svn:date"
                           >>= return . fromJust . parseW3CDateTime . chomp . fromJust
 
+               isLocked <- getRevisionProp "rakka:isLocked"
+                           >>= return . isJust
+
                return Redirection {
                             redirName       = name
                           , redirDest       = dest
+                          , redirIsLocked   = isLocked
                           , redirRevision   = pageRev
                           , redirLastMod    = zonedTimeToUTC lastMod
                           , redirUpdateInfo = undefined
@@ -244,7 +276,7 @@ putPageIntoRepository repos userID page
                setNodeProp path "rakka:lang"      Nothing
                setNodeProp path "rakka:isTheme"   Nothing
                setNodeProp path "rakka:isFeed"    Nothing
-               setNodeProp path "rakka:isLocked"  Nothing
+               setNodeProp path "rakka:isLocked"  (encodeFlag $ redirIsLocked page)
                setNodeProp path "rakka:isBinary"  Nothing
                setNodeProp path "rakka:summary"   Nothing
                setNodeProp path "rakka:otherLang" Nothing