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
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
--------------------------------------------------------------------------------
module Hakyll.Core.Compiler.Require
( Snapshot
, save
, saveSnapshot
, require
, requireSnapshot
, requireBody
, requireSnapshotBody
, requireAll
, requireAllSnapshots
) 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.Metadata
import Hakyll.Core.Store (Store)
import qualified Hakyll.Core.Store as Store
--------------------------------------------------------------------------------
-- | Whilst compiling an item, it possible to save multiple snapshots of it, and
-- not just the final result.
type Snapshot = String
--------------------------------------------------------------------------------
save :: (Binary a, Typeable a) => Store -> Item a -> IO ()
save store item = saveSnapshot store final item
--------------------------------------------------------------------------------
-- | Save a specific snapshot of an item, so you can load it later using
-- 'requireSnapshot'.
saveSnapshot :: (Binary a, Typeable a)
=> Store -> Snapshot -> Item a -> IO ()
saveSnapshot store snapshot item =
Store.set store (key (itemIdentifier item) snapshot) (itemBody item)
--------------------------------------------------------------------------------
-- | Load an item compiled elsewhere. If the required item is not yet compiled,
-- the build system will take care of that automatically.
require :: (Binary a, Typeable a) => Identifier -> Compiler (Item a)
require id' = requireSnapshot id' final
--------------------------------------------------------------------------------
-- | Require a specific snapshot of an item.
requireSnapshot :: (Binary a, Typeable a)
=> Identifier -> Snapshot -> Compiler (Item a)
requireSnapshot id' snapshot = do
store <- compilerStore <$> compilerAsk
compilerTellDependencies [IdentifierDependency id']
compilerResult $ CompilerRequire id' $ do
result <- compilerUnsafeIO $ Store.get store (key id' snapshot)
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' ++
" (snapshot " ++ snapshot ++ ") 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' ++
" (snapshot " ++ snapshot ++ ") was found in the cache, " ++
"but does not have the right type: expected " ++ show e ++
" but got " ++ show r
--------------------------------------------------------------------------------
-- | A shortcut for only requiring the body of an item.
--
-- > requireBody = fmap itemBody . require
requireBody :: (Binary a, Typeable a) => Identifier -> Compiler a
requireBody id' = requireSnapshotBody id' final
--------------------------------------------------------------------------------
requireSnapshotBody :: (Binary a, Typeable a)
=> Identifier -> Snapshot -> Compiler a
requireSnapshotBody id' snapshot = fmap itemBody $ requireSnapshot id' snapshot
--------------------------------------------------------------------------------
-- | This function allows you to 'require' a dynamic list of items
requireAll :: (Binary a, Typeable a) => Pattern -> Compiler [Item a]
requireAll pattern = requireAllSnapshots pattern final
--------------------------------------------------------------------------------
requireAllSnapshots :: (Binary a, Typeable a)
=> Pattern -> Snapshot -> Compiler [Item a]
requireAllSnapshots pattern snapshot = do
matching <- getMatches pattern
mapM (\i -> requireSnapshot i snapshot) matching
--------------------------------------------------------------------------------
key :: Identifier -> String -> [String]
key identifier snapshot =
["Hakyll.Core.Compiler.Require", show identifier, snapshot]
--------------------------------------------------------------------------------
final :: Snapshot
final = "_final"
|
