git.iko.soy/hakyll
on 5dba607 help sign in
hakyll/src/Hakyll/Core/Store.hs
103 lines 3.0 kB history raw
1-- | A store for stroing and retreiving items
2--
3{-# LANGUAGE ExistentialQuantification, ScopedTypeVariables #-}
4module Hakyll.Core.Store
5 ( Store
6 , StoreGet (..)
7 , makeStore
8 , storeSet
9 , storeGet
10 ) where
12import Control.Concurrent.MVar (MVar, newMVar, readMVar, modifyMVar_)
13import System.FilePath ((</>))
14import System.Directory (doesFileExist)
15import Data.Maybe (fromMaybe)
16import Data.Map (Map)
17import qualified Data.Map as M
19import Data.Binary (Binary, encodeFile, decodeFile)
20import Data.Typeable (Typeable, TypeRep, cast, typeOf)
22import Hakyll.Core.Identifier
23import Hakyll.Core.Util.File
25-- | Items we can store
26--
27data Storable = forall a. (Binary a, Typeable a) => Storable a
29-- | Result when an item from the store
30--
31data StoreGet a = Found a
32 | NotFound
33 | WrongType TypeRep TypeRep
34 deriving (Show, Eq)
36-- | Data structure used for the store
37--
38data Store = Store
39 { -- | All items are stored on the filesystem
40 storeDirectory :: FilePath
41 , -- | And some items are also kept in-memory
42 storeMap :: MVar (Map FilePath Storable)
43 }
45-- | Initialize the store
46--
47makeStore :: FilePath -> IO Store
48makeStore directory = do
49 mvar <- newMVar M.empty
50 return Store
51 { storeDirectory = directory
52 , storeMap = mvar
53 }
55-- | Auxiliary: add an item to the map
56--
57addToMap :: (Binary a, Typeable a) => Store -> FilePath -> a -> IO ()
58addToMap store path value =
59 modifyMVar_ (storeMap store) $ return . M.insert path (Storable value)
61-- | Create a path
62--
63makePath :: Store -> String -> Identifier a -> FilePath
64makePath store name identifier = storeDirectory store </> name
65 </> group </> toFilePath identifier </> "hakyllstore"
66 where
67 group = fromMaybe "" $ identifierGroup identifier
69-- | Store an item
70--
71storeSet :: (Binary a, Typeable a)
72 => Store -> String -> Identifier a -> a -> IO ()
73storeSet store name identifier value = do
74 makeDirectories path
75 encodeFile path value
76 addToMap store path value
77 where
78 path = makePath store name identifier
80-- | Load an item
81--
82storeGet :: forall a. (Binary a, Typeable a)
83 => Store -> String -> Identifier a -> IO (StoreGet a)
84storeGet store name identifier = do
85 -- 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'
92 -- Not found in the map, try the filesystem
93 Nothing -> do
94 exists <- doesFileExist path
95 if not exists
96 -- Not found in the filesystem either
97 then return NotFound
98 -- Found in the filesystem
99 else do v <- decodeFile path
100 addToMap store path v
101 return $ Found v
102 where
103 path = makePath store name identifier