on f104f91 help sign in
hakyll/src/Hakyll/Core/Store.hs
88 lines 2.5 kB history raw
1-- | A store for stroing and retreiving items
2--
3module Hakyll.Core.Store
4 ( Store
5 , makeStore
6 , storeSet
7 , storeGet
8 ) where
10import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
11import System.FilePath ((</>))
12import System.Directory (doesFileExist)
13import Data.Map (Map)
14import qualified Data.Map as M
16import Data.Binary (Binary, encodeFile, decodeFile)
17import Data.Typeable (Typeable)
19import Hakyll.Core.CompiledItem
20import Hakyll.Core.Writable
21import Hakyll.Core.Identifier
22import Hakyll.Core.Util.File
24-- | Data structure used for the store
25--
26data Store = Store
27 { -- | All items are stored on the filesystem
28 storeDirectory :: FilePath
29 , -- | And some items are also kept in-memory
30 storeMap :: MVar (Map FilePath CompiledItem)
31 }
33-- | Initialize the store
34--
35makeStore :: FilePath -> IO Store
36makeStore directory = do
37 mvar <- newMVar M.empty
38 return Store
39 { storeDirectory = directory
40 , storeMap = mvar
41 }
43-- | Auxiliary: add an item to the map
44--
45addToMap :: (Binary a, Typeable a, Writable a)
46 => Store -> FilePath -> a -> IO ()
47addToMap store path value =
48 modifyMVar_ (storeMap store) $ return . M.insert path (compiledItem value)
50-- | Create a path
51--
52makePath :: Store -> String -> Identifier -> FilePath
53makePath store name identifier =
54 storeDirectory store </> name </> toFilePath identifier
56-- | Store an item
57--
58storeSet :: (Binary a, Typeable a, Writable a)
59 => Store -> String -> Identifier -> a -> IO ()
60storeSet store name identifier value = do
61 makeDirectories path
62 encodeFile path value
63 addToMap store path value
64 where
65 path = makePath store name identifier
67-- | Load an item
68--
69storeGet :: (Binary a, Typeable a, Writable a)
70 => Store -> String -> Identifier -> IO (Maybe a)
71storeGet store name identifier = do
72 -- First check the in-memory map
73 map' <- readMVar $ storeMap store
74 case M.lookup path map' of
75 -- Found in the in-memory map
76 Just c -> return $ Just $ unCompiledItem c
77 -- Not found in the map, try the filesystem
78 Nothing -> do
79 exists <- doesFileExist path
80 if not exists
81 -- Not found in the filesystem either
82 then return Nothing
83 -- Found in the filesystem
84 else do v <- decodeFile path
85 addToMap store path v
86 return $ Just v
87 where
88 path = makePath store name identifier