X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Rakka.git;a=blobdiff_plain;f=Rakka%2FStorage%2FRepos.hs;h=01f64c7a581889321f03f26c47170cff343164b1;hp=e1f4b8e24049cab6d564666974328d948f1f4bf4;hb=b101c0a9aad609704eaa9157fe809be80d2aacf7;hpb=354a3b69406608a2570060bdbdbc65e83260c8ff diff --git a/Rakka/Storage/Repos.hs b/Rakka/Storage/Repos.hs index e1f4b8e..01f64c7 100644 --- 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