@@ -9,6 +9,7 @@ module Hakyll.Core.Store
12+import Control.Applicative ((<$>))
12import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
13import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
13import System.FilePath ((</>))
14import System.FilePath ((</>))
14import System.Directory (doesFileExist)
15import System.Directory (doesFileExist)
@@ -39,14 +40,16 @@ data Store = Store
39 { -- | All items are stored on the filesystem
40 { -- | All items are stored on the filesystem
40 storeDirectory :: FilePath
41 storeDirectory :: FilePath
41 , -- | And some items are also kept in-memory
42 , -- | And some items are also kept in-memory
42− storeMap :: MVar (Map FilePath Storable)
43+ storeMap :: Maybe (MVar (Map FilePath Storable))
45-- | Initialize the store
46-- | Initialize the store
47−makeStore :: FilePath -> IO Store
48+makeStore :: Bool -- ^ Use in-memory caching
49+ -> FilePath -- ^ Directory to use for hard disk storage
50+ -> IO Store -- ^ Store
48−makeStore directory = do
51+makeStore inMemory directory = do
49− mvar <- newMVar M.empty
52+ mvar <- if inMemory then Just <$> newMVar M.empty else return Nothing
50 return Store
53 return Store
51 { storeDirectory = directory
54 { storeDirectory = directory
52 , storeMap = mvar
55 , storeMap = mvar
@@ -54,9 +57,23 @@ makeStore directory = do
55-- | Auxiliary: add an item to the map
58-- | Auxiliary: add an item to the map
57−addToMap :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
60+cacheInsert :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
58−addToMap store path value =
61+cacheInsert (Store _ Nothing) _ _ = return ()
62+cacheInsert (Store _ (Just mv)) path value =
59− modifyMVar_ (storeMap store) $ return . M.insert path (Storable value)
63+ modifyMVar_ mv $ return . M.insert path (Storable value)
65+-- | Auxiliary: get an item from the cache
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
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)
61-- | Create a path
78-- | Create a path
@@ -73,31 +90,29 @@ storeSet :: (Binary a, Typeable a)
73storeSet store name identifier value = do
90storeSet store name identifier value = do
74 makeDirectories path
91 makeDirectories path
75 encodeFile path value
92 encodeFile path value
76− addToMap store path value
93+ cacheInsert store path value
78 path = makePath store name identifier
95 path = makePath store name identifier
80-- | Load an item
97-- | Load an item
82−storeGet :: forall a. (Binary a, Typeable a)
99+storeGet :: (Binary a, Typeable a)
83 => Store -> String -> Identifier a -> IO (StoreGet a)
100 => Store -> String -> Identifier a -> IO (StoreGet a)
84storeGet store name identifier = do
101storeGet store name identifier = do
85 -- First check the in-memory map
102 -- First check the in-memory map
86− map' <- readMVar $ storeMap store
103+ mv <- cacheLookup store path
87− case M.lookup path map' of
104+ case mv 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)
92 -- Not found in the map, try the filesystem
105 -- Not found in the map, try the filesystem
93− Nothing -> do
106+ NotFound -> do
94 exists <- doesFileExist path
107 exists <- doesFileExist path
95 if not exists
108 if not exists
96 -- Not found in the filesystem either
109 -- Not found in the filesystem either
97 then return NotFound
110 then return NotFound
98 -- Found in the filesystem
111 -- Found in the filesystem
99 else do v <- decodeFile path
112 else do v <- decodeFile path
100− addToMap store path v
113+ cacheInsert store path v
101 return $ Found v
114 return $ Found v
115+ -- Found in the in-memory map, just return
103 path = makePath store name identifier
118 path = makePath store name identifier