@@ -9,6 +9,7 @@ module Hakyll.Core.Store
99 , storeGet
1010 ) where
1111
12+import Control.Applicative ((<$>))
1213import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
1314import System.FilePath ((</>))
1415import System.Directory (doesFileExist)
@@ -39,14 +40,16 @@ data Store = Store
3940 { -- | All items are stored on the filesystem
4041 storeDirectory :: FilePath
4142 , -- | And some items are also kept in-memory
42− storeMap :: MVar (Map FilePath Storable)
43+ storeMap :: Maybe (MVar (Map FilePath Storable))
4344 }
4445
4546-- | Initialize the store
4647--
47−makeStore :: FilePath -> IO Store
48−makeStore directory = do
49− mvar <- newMVar M.empty
48+makeStore :: Bool -- ^ Use in-memory caching
49+ -> FilePath -- ^ Directory to use for hard disk storage
50+ -> IO Store -- ^ Store
51+makeStore inMemory directory = do
52+ mvar <- if inMemory then Just <$> newMVar M.empty else return Nothing
5053 return Store
5154 { storeDirectory = directory
5255 , storeMap = mvar
@@ -54,9 +57,23 @@ makeStore directory = do
5457
5558-- | Auxiliary: add an item to the map
5659--
57−addToMap :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
58−addToMap store path value =
59− modifyMVar_ (storeMap store) $ return . M.insert path (Storable value)
60+cacheInsert :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
61+cacheInsert (Store _ Nothing) _ _ = return ()
62+cacheInsert (Store _ (Just mv)) path value =
63+ modifyMVar_ mv $ return . M.insert path (Storable value)
64+
65+-- | Auxiliary: get an item from the cache
66+--
67+cacheLookup :: forall a. (Binary a, Typeable a)
68+ => Store -> FilePath -> IO (StoreGet a)
69+cacheLookup (Store _ Nothing) _ = return NotFound
70+cacheLookup (Store _ (Just mv)) path = do
71+ map' <- readMVar mv
72+ case M.lookup path map' of
73+ Nothing -> return NotFound
74+ Just (Storable s) -> return $ case cast s of
75+ Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
76+ Just s' -> Found s'
6077
6178-- | Create a path
6279--
@@ -73,31 +90,29 @@ storeSet :: (Binary a, Typeable a)
7390storeSet store name identifier value = do
7491 makeDirectories path
7592 encodeFile path value
76− addToMap store path value
93+ cacheInsert store path value
7794 where
7895 path = makePath store name identifier
7996
8097-- | Load an item
8198--
82−storeGet :: forall a. (Binary a, Typeable a)
99+storeGet :: (Binary a, Typeable a)
83100 => Store -> String -> Identifier a -> IO (StoreGet a)
84101storeGet store name identifier = do
85102 -- First check the in-memory map
86− map' <- readMVar $ storeMap store
87− case M.lookup path map' of
88− -- Found in the in-memory map
89− Just (Storable s) -> return $ case cast s of
90− Nothing -> WrongType (typeOf s) $ typeOf (undefined :: a)
91− Just s' -> Found s'
103+ mv <- cacheLookup store path
104+ case mv of
92105 -- Not found in the map, try the filesystem
93− Nothing -> do
106+ NotFound -> do
94107 exists <- doesFileExist path
95108 if not exists
96109 -- Not found in the filesystem either
97110 then return NotFound
98111 -- Found in the filesystem
99112 else do v <- decodeFile path
100− addToMap store path v
113+ cacheInsert store path v
101114 return $ Found v
115+ -- Found in the in-memory map, just return
116+ s -> return s
102117 where
103118 path = makePath store name identifier