1 module Rakka.Storage.Impl
9 import Control.Concurrent
10 import Control.Concurrent.STM
14 import qualified Data.Set as S
15 import Network.HTTP.Lucu
18 import Rakka.Storage.DefaultPage
19 import Rakka.Storage.Repos
20 import Rakka.Storage.Types
21 import Subversion.Types
22 import Subversion.FileSystem
23 import Subversion.Repository
24 import System.Directory
25 import System.FilePath
27 import System.Log.Logger
28 import Text.HyperEstraier hiding (WriteLock)
32 logger = "Rakka.Storage"
35 getPage' :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
36 getPage' repos name rev
37 = do page <- loadPageInRepository repos name rev
39 Nothing -> loadDefaultPage name
43 putPage' :: Repository -> Page -> IO StatusCode
44 putPage' = putPageIntoRepository
47 deletePage' :: Repository -> PageName -> IO StatusCode
48 deletePage' = deletePageFromRepository
51 findAllPages :: Repository -> RevNum -> IO (Set PageName)
52 findAllPages _ 0 = findAllDefaultPages
53 findAllPages repos rev = do reposPages <- findAllPagesInRevision repos rev
54 defaultPages <- findAllDefaultPages
55 return (reposPages `S.union` defaultPages)
58 findChangedPages :: Repository -> RevNum -> RevNum -> IO (Set PageName)
59 findChangedPages repos 0 newRev = findAllPages repos newRev
60 findChangedPages repos oldRev newRev
61 = mapM (findChangedPagesAtRevision repos) [oldRev + 1 .. newRev]
66 getCurrentRevNum :: Repository -> IO RevNum
67 getCurrentRevNum repos
68 = getRepositoryFS repos >>= getYoungestRev
71 startIndexManager :: FilePath -> Repository -> (Page -> IO Document) -> IO (TChan IndexReq)
72 startIndexManager lsdir repos mkDraft
73 = do chan <- newTChanIO
74 index <- openIndex indexDir revFile
75 forkIO (loop chan index)
78 indexDir = lsdir </> "index"
79 revFile = lsdir </> "indexRev"
81 loop :: TChan IndexReq -> Database -> IO ()
83 = do req <- atomically $ readTChan chan
86 -> do noticeM logger "Rebuilding the H.E. index..."
88 removeDirectoryRecursive indexDir
89 index' <- openIndex indexDir revFile
90 syncIndex' index' revFile repos mkDraft
94 -> do syncIndex' index revFile repos mkDraft
98 -> do result <- searchIndex index cond
99 atomically $ putTMVar var result
103 -- casket を R/W モードで開く。成功したらそのまま返し、失敗したら
104 -- indexDir と revFile を削除してから casket を R/W モードで開く。
105 openIndex :: FilePath -> FilePath -> IO Database
106 openIndex indexDir revFile
107 = do ret <- openDatabase indexDir (Writer [])
110 -> do debugM logger ("Opened an H.E. index on " ++ indexDir)
114 -> do noticeM logger ("Failed to open an H.E. index on "
115 ++ indexDir ++ ": " ++ show err)
117 indexExists <- doesDirectoryExist indexDir
119 $ removeDirectoryRecursive indexDir
121 revFileExists <- doesFileExist revFile
125 Right index <- openDatabase indexDir (Writer [Create []])
126 addAttrIndex index "@uri" SeqIndex
127 addAttrIndex index "rakka:revision" SeqIndex
128 noticeM logger ("Created an H.E. index on " ++ indexDir)
133 syncIndex' :: Database -> FilePath -> Repository -> (Page -> IO Document) -> IO ()
134 syncIndex' index revFile repos mkDraft
135 = updateIndexRev revFile $ \ oldRev ->
136 do debugM logger ("The index revision is currently " ++ show oldRev)
138 newRev <- getCurrentRevNum repos
139 debugM logger ("The repository revision is currently " ++ show newRev)
141 when (oldRev == 0 || newRev /= oldRev)
142 $ syncIndex'' oldRev newRev
145 syncIndex'' :: RevNum -> RevNum -> IO ()
146 syncIndex'' oldRev newRev
147 = do pages <- findChangedPages repos oldRev newRev
148 mapM_ (updateIndex index repos mkDraft newRev) (S.toList pages)
151 searchIndex :: Database -> Condition -> IO [(PageName, RevNum)]
152 searchIndex index cond
153 = searchDatabase index cond >>= mapM fromId
155 fromId :: DocumentID -> IO (PageName, RevNum)
157 = do uri <- getDocURI index docId
158 rev <- getDocAttr index docId "rakka:revision"
159 >>= return . read . fromJust
160 return (decodePageName $ uriPath uri, rev)
163 updateIndex :: Database
165 -> (Page -> IO Document)
169 updateIndex index repos mkDraft rev name
170 = do pageM <- getPage' repos name (Just rev)
174 -> do docIdM <- getDocIdByURI index (mkRakkaURI name)
177 Just docId -> do removeDocument index docId [CleaningRemove]
178 infoM logger ("Removed page " ++ name ++ " from the index")
180 -> do draft <- mkDraft page
181 putDocument index draft [CleaningPut]
182 infoM logger ("Indexed page " ++ name ++ " of revision " ++ show (pageRevision page))
185 updateIndexRev :: FilePath -> (RevNum -> IO RevNum) -> IO ()
186 updateIndexRev revFile f = withFile revFile ReadWriteMode update
188 update :: Handle -> IO ()
189 update h = do eof <- hIsEOF h
193 hGetLine h >>= return . read
195 hSeek h AbsoluteSeek 0
197 hPutStrLn h (show rev')