blob: a7c47ce7d000ccf7e4c4b4a74115c90bc45c9bb0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
|
--------------------------------------------------------------------------------
module Hakyll.Core.Compiler.Require
( save
, require
, requireBody
, requireAll
) where
--------------------------------------------------------------------------------
import Control.Applicative ((<$>))
import Data.Binary (Binary)
import Data.Typeable
--------------------------------------------------------------------------------
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Dependencies
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Item
import Hakyll.Core.Store (Store)
import qualified Hakyll.Core.Store as Store
--------------------------------------------------------------------------------
save :: (Binary a, Typeable a) => Store -> Identifier -> a -> IO ()
save store identifier x = Store.set store (key identifier) x
--------------------------------------------------------------------------------
require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
require id' = do
store <- compilerStore <$> compilerAsk
compilerTellDependencies [IdentifierDependency id']
compilerResult $ CompilerRequire id' $ do
result <- compilerUnsafeIO $ Store.get store (key id')
case result of
Store.NotFound -> compilerThrow notFound
Store.WrongType e r -> compilerThrow $ wrongType e r
Store.Found x -> return $ Item id' x
where
notFound =
"Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was " ++
"not found in the cache, the cache might be corrupted or " ++
"the item you are referring to might not exist"
wrongType e r =
"Hakyll.Core.Compiler.Require.require: " ++ show id' ++ " was found " ++
"in the cache, but does not have the right type: expected " ++ show e ++
" but got " ++ show r
--------------------------------------------------------------------------------
requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
requireBody = fmap itemBody . require
--------------------------------------------------------------------------------
requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
requireAll pattern = do
universe <- compilerUniverse <$> compilerAsk
let matching = filterMatches pattern universe
compilerTellDependencies [PatternDependency pattern matching]
mapM require matching
--------------------------------------------------------------------------------
key :: Identifier -> [String]
key identifier = ["Hakyll.Core.Compiler.Require", show identifier]
|
