on 877cb21 help sign in
63 lines 2.5 kB history raw
1--------------------------------------------------------------------------------
2module Hakyll.Core.Compiler.Require
3 ( save
4 , require
5 , requireAll
6 ) where
9--------------------------------------------------------------------------------
10import Control.Applicative ((<$>))
11import Data.Binary (Binary)
12import Data.Typeable
15--------------------------------------------------------------------------------
16import Hakyll.Core.Compiler.Internal
17import Hakyll.Core.Dependencies
18import Hakyll.Core.Identifier
19import Hakyll.Core.Identifier.Pattern
20import Hakyll.Core.Store (Store)
21import qualified Hakyll.Core.Store as Store
24--------------------------------------------------------------------------------
25save :: (Binary a, Typeable a) => Store -> Identifier -> a -> IO ()
26save store identifier x = Store.set store (key identifier) x
29--------------------------------------------------------------------------------
30require :: (Binary a, Typeable a) => Identifier -> Compiler a
31require id' = do
32 store <- compilerStore <$> compilerAsk
34 compilerTellDependencies [IdentifierDependency id']
35 compilerResult $ CompilerRequire id' $ do
36 result <- compilerUnsafeIO $ Store.get store (key id')
37 case result of
38 Store.NotFound -> compilerThrow notFound
39 Store.WrongType e r -> compilerThrow $ wrongType e r
40 Store.Found x -> return x
41 where
42 notFound =
43 "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++
44 "not found in the cache, the cache might be corrupted or " ++
45 "the item you are referring to might not exist"
46 wrongType e r =
47 "Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was found " ++
48 "in the cache, but does not have the right type: expected " ++ show e ++
49 " but got " ++ show r
52--------------------------------------------------------------------------------
53requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [a]
54requireAll pattern = do
55 universe <- compilerUniverse <$> compilerAsk
56 let matching = filterMatches pattern universe
57 compilerTellDependencies [PatternDependency pattern matching]
58 mapM require matching
61--------------------------------------------------------------------------------
62key :: Identifier -> [String]
63key identifier = ["Hakyll.Core.Compiler.Require", show identifier]