module Rakka.Storage.Impl
( getPage'
+ , putPage'
, startIndexManager
)
where
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S
+import Network.HTTP.Lucu
import Network.URI
import Rakka.Page
import Rakka.Storage.DefaultPage
+import Rakka.Storage.Repos
import Rakka.Storage.Types
import Subversion.Types
+import Subversion.FileSystem
+import Subversion.Repository
import System.Directory
import System.FilePath
import System.IO
import System.Posix.Files
import System.Posix.Types
import System.Posix.IO
-import Subversion.FileSystem
-import Subversion.Repository
import Text.HyperEstraier hiding (WriteLock)
+
+logger :: String
logger = "Rakka.Storage"
getPage' :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
getPage' repos name rev
- = loadDefaultPage name -- FIXME
+ = do page <- loadPageInRepository repos name rev
+ case page of
+ Nothing -> loadDefaultPage name
+ p -> return p
+
+
+putPage' :: Repository -> Page -> IO StatusCode
+putPage' = putPageIntoRepository
findAllPages :: Repository -> RevNum -> IO (Set PageName)
findAllPages _ 0 = findAllDefaultPages
-findAllPages repos rev
- = findAllDefaultPages -- FIXME
+findAllPages repos rev = do reposPages <- findAllPagesInRevision repos rev
+ defaultPages <- findAllDefaultPages
+ return (reposPages `S.union` defaultPages)
findChangedPages :: Repository -> RevNum -> RevNum -> IO (Set PageName)
findChangedPages repos 0 newRev = findAllPages repos newRev
findChangedPages repos oldRev newRev
- = fail "FIXME: not impl"
+ = mapM (findChangedPagesAtRevision repos) [oldRev + 1 .. newRev]
+ >>=
+ return . S.unions
getCurrentRevNum :: Repository -> IO RevNum
loop chan index
= do req <- atomically $ readTChan chan
case req of
+ RebuildIndex
+ -> do noticeM logger "Rebuilding the H.E. index..."
+ closeDatabase index
+ removeDirectoryRecursive indexDir
+ index' <- openIndex indexDir revFile
+ syncIndex' index' revFile repos mkDraft
+ loop chan index'
+
SyncIndex
- -> syncIndex' index revFile repos mkDraft
+ -> do syncIndex' index revFile repos mkDraft
+ loop chan index
+
SearchIndex cond var
-> do result <- searchIndex index cond
atomically $ putTMVar var result
- loop chan index
+ loop chan index
-- casket を R/W モードで開く。成功したらそのまま返し、失敗したら
return index
Left err
- -> do warningM logger ("Failed to open an H.E. index on "
- ++ indexDir ++ ": " ++ show err)
+ -> do noticeM logger ("Failed to open an H.E. index on "
+ ++ indexDir ++ ": " ++ show err)
indexExists <- doesDirectoryExist indexDir
when indexExists
newRev <- getCurrentRevNum repos
debugM logger ("The repository revision is currently " ++ show newRev)
- when (newRev /= oldRev) (syncIndex'' oldRev newRev)
+ when (oldRev == 0 || newRev /= oldRev)
+ $ syncIndex'' oldRev newRev
return newRev
where
syncIndex'' :: RevNum -> RevNum -> IO ()