1 module Rakka.Storage.Impl
10 import Control.Concurrent
11 import Control.Concurrent.STM
15 import qualified Data.Set as S
16 import Network.HTTP.Lucu
19 import Rakka.Storage.DefaultPage
20 import Rakka.Storage.Repos
21 import Rakka.Storage.Types
22 import Subversion.Types
23 import Subversion.FileSystem
24 import Subversion.Repository
25 import System.Directory
26 import System.FilePath
28 import System.Log.Logger
29 import Text.HyperEstraier hiding (WriteLock)
33 logger = "Rakka.Storage"
36 getPage' :: Repository -> PageName -> Maybe RevNum -> IO (Maybe Page)
37 getPage' repos name rev
38 = do page <- loadPageInRepository repos name rev
40 Nothing -> loadDefaultPage name
44 putPage' :: Repository -> Maybe String -> Page -> IO StatusCode
45 putPage' = putPageIntoRepository
48 deletePage' :: Repository -> Maybe String -> PageName -> IO StatusCode
49 deletePage' = deletePageFromRepository
52 findAllPages :: Repository -> RevNum -> IO (Set PageName)
53 findAllPages _ 0 = findAllDefaultPages
54 findAllPages repos rev = do reposPages <- findAllPagesInRevision repos rev
55 defaultPages <- findAllDefaultPages
56 return (reposPages `S.union` defaultPages)
59 findChangedPages :: Repository -> RevNum -> RevNum -> IO (Set PageName)
60 findChangedPages repos 0 newRev = findAllPages repos newRev
61 findChangedPages repos oldRev newRev
62 = mapM (findChangedPagesAtRevision repos) [oldRev + 1 .. newRev]
67 getDirContents' :: Repository -> PageName -> Maybe RevNum -> IO [PageName]
68 getDirContents' repos name rev
69 = do reposPages <- getDirContentsInRevision repos name rev
70 defaultPages <- getDefaultDirContents name
71 return $ S.toList (reposPages `S.union` defaultPages)
74 getCurrentRevNum :: Repository -> IO RevNum
75 getCurrentRevNum repos
76 = getRepositoryFS repos >>= getYoungestRev
79 startIndexManager :: FilePath -> Repository -> (Page -> IO Document) -> IO (TChan IndexReq)
80 startIndexManager lsdir repos mkDraft
81 = do chan <- newTChanIO
82 index <- openIndex indexDir revFile
83 forkIO (loop chan index)
86 indexDir = lsdir </> "index"
87 revFile = lsdir </> "indexRev"
89 loop :: TChan IndexReq -> Database -> IO ()
91 = do req <- atomically $ readTChan chan
94 -> do noticeM logger "Rebuilding the H.E. index..."
96 removeDirectoryRecursive indexDir
97 index' <- openIndex indexDir revFile
98 syncIndex' index' revFile repos mkDraft
102 -> do syncIndex' index revFile repos mkDraft
106 -> do result <- searchIndex index cond
107 atomically $ putTMVar var result
111 -- casket を R/W モードで開く。成功したらそのまま返し、失敗したら
112 -- indexDir と revFile を削除してから casket を R/W モードで開く。
113 openIndex :: FilePath -> FilePath -> IO Database
114 openIndex indexDir revFile
115 = do ret <- openDatabase indexDir (Writer [])
118 -> do debugM logger ("Opened an H.E. index on " ++ indexDir)
122 -> do noticeM logger ("Failed to open an H.E. index on "
123 ++ indexDir ++ ": " ++ show err)
125 indexExists <- doesDirectoryExist indexDir
127 $ removeDirectoryRecursive indexDir
129 revFileExists <- doesFileExist revFile
133 Right index <- openDatabase indexDir (Writer [Create []])
134 addAttrIndex index "@type" StrIndex
135 addAttrIndex index "@uri" SeqIndex
136 addAttrIndex index "rakka:revision" SeqIndex
137 noticeM logger ("Created an H.E. index on " ++ indexDir)
142 syncIndex' :: Database -> FilePath -> Repository -> (Page -> IO Document) -> IO ()
143 syncIndex' index revFile repos mkDraft
144 = updateIndexRev revFile $ \ oldRev ->
145 do debugM logger ("The index revision is currently " ++ show oldRev)
147 newRev <- getCurrentRevNum repos
148 debugM logger ("The repository revision is currently " ++ show newRev)
150 when (oldRev == 0 || newRev /= oldRev)
151 $ syncIndex'' oldRev newRev
154 syncIndex'' :: RevNum -> RevNum -> IO ()
155 syncIndex'' oldRev newRev
156 = do pages <- findChangedPages repos oldRev newRev
157 mapM_ (updateIndex index repos mkDraft newRev) (S.toList pages)
160 searchIndex :: Database -> Condition -> IO [(PageName, RevNum)]
161 searchIndex index cond
162 = searchDatabase index cond >>= mapM fromId
164 fromId :: DocumentID -> IO (PageName, RevNum)
166 = do uri <- getDocURI index docId
167 rev <- getDocAttr index docId "rakka:revision"
168 >>= return . read . fromJust
169 return (decodePageName $ uriPath uri, rev)
172 updateIndex :: Database
174 -> (Page -> IO Document)
178 updateIndex index repos mkDraft rev name
179 = do pageM <- getPage' repos name (Just rev)
183 -> do docIdM <- getDocIdByURI index (mkRakkaURI name)
186 Just docId -> do removeDocument index docId [CleaningRemove]
187 infoM logger ("Removed page " ++ name ++ " from the index")
189 -> do draft <- mkDraft page
190 putDocument index draft [CleaningPut]
191 infoM logger ("Indexed page " ++ name ++ " of revision " ++ show (pageRevision page))
194 updateIndexRev :: FilePath -> (RevNum -> IO RevNum) -> IO ()
195 updateIndexRev revFile f = withFile revFile ReadWriteMode update
197 update :: Handle -> IO ()
198 update h = do eof <- hIsEOF h
202 hGetLine h >>= return . read
204 hSeek h AbsoluteSeek 0
206 hPutStrLn h (show rev')