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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
-- | A Compiler manages targets and dependencies between targets.
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Compiler
( Compiler
, runCompiler
, getIdentifier
, getRoute
, getResourceString
, fromDependency
, require_
, require
, requireA
, requireAll_
, requireAll
, requireAllA
, cached
, unsafeCompiler
) where
import Prelude hiding ((.), id)
import Control.Arrow ((>>>), (&&&), arr)
import Control.Applicative ((<$>))
import Control.Monad.Reader (ask)
import Control.Monad.Trans (liftIO)
import Control.Category (Category, (.), id)
import Data.Maybe (fromMaybe)
import Data.Binary (Binary)
import Data.Typeable (Typeable)
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.CompiledItem
import Hakyll.Core.Writable
import Hakyll.Core.ResourceProvider
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Store
import Hakyll.Core.Rules
import Hakyll.Core.Routes
-- | Run a compiler, yielding the resulting target and it's dependencies. This
-- version of 'runCompilerJob' also stores the result
--
runCompiler :: Compiler () CompileRule -- ^ Compiler to run
-> Identifier -- ^ Target identifier
-> ResourceProvider -- ^ Resource provider
-> Routes -- ^ Route
-> Store -- ^ Store
-> Bool -- ^ Was the resource modified?
-> IO CompileRule -- ^ Resulting item
runCompiler compiler identifier provider routes store modified = do
-- Run the compiler job
result <- runCompilerJob compiler identifier provider routes store modified
-- Inspect the result
case result of
-- In case we compiled an item, we will store a copy in the cache first,
-- before we return control. This makes sure the compiled item can later
-- be accessed by e.g. require.
CompileRule (CompiledItem x) ->
storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
-- Otherwise, we do nothing here
_ -> return ()
return result
-- | Get the identifier of the item that is currently being compiled
--
getIdentifier :: Compiler a Identifier
getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask
-- | Get the route we are using for this item
--
getRoute :: Compiler a (Maybe FilePath)
getRoute = fromJob $ const $ CompilerM $ do
identifier <- compilerIdentifier <$> ask
routes <- compilerRoutes <$> ask
return $ runRoutes routes identifier
-- | Get the resource we are compiling as a string
--
getResourceString :: Compiler a String
getResourceString = getIdentifier >>> getResourceString'
where
getResourceString' = fromJob $ \id' -> CompilerM $ do
provider <- compilerResourceProvider <$> ask
liftIO $ resourceString provider id'
-- | Auxiliary: get a dependency
--
getDependency :: (Binary a, Writable a, Typeable a)
=> Identifier -> CompilerM a
getDependency identifier = CompilerM $ do
store <- compilerStore <$> ask
fmap (fromMaybe error') $ liftIO $
storeGet store "Hakyll.Core.Compiler.runCompiler" identifier
where
error' = error $ "Hakyll.Core.Compiler.getDependency: "
++ show identifier
++ " not found in the cache, the cache might be corrupted or"
++ " the item you are referring to might not exist"
-- | Variant of 'require' which drops the current value
--
require_ :: (Binary a, Typeable a, Writable a)
=> Identifier
-> Compiler b a
require_ identifier =
fromDependency identifier >>> fromJob (const $ getDependency identifier)
-- | Require another target. Using this function ensures automatic handling of
-- dependencies
--
require :: (Binary a, Typeable a, Writable a)
=> Identifier
-> (b -> a -> c)
-> Compiler b c
require identifier = requireA identifier . arr . uncurry
-- | Arrow-based variant of 'require'
--
requireA :: (Binary a, Typeable a, Writable a)
=> Identifier
-> Compiler (b, a) c
-> Compiler b c
requireA identifier = (id &&& require_ identifier >>>)
-- | Variant of 'requireAll' which drops the current value
--
requireAll_ :: (Binary a, Typeable a, Writable a)
=> Pattern
-> Compiler b [a]
requireAll_ pattern = fromDependencies getDeps >>> fromJob requireAll_'
where
getDeps = matches pattern . resourceList
requireAll_' = const $ CompilerM $ do
deps <- getDeps . compilerResourceProvider <$> ask
mapM (unCompilerM . getDependency) deps
-- | Require a number of targets. Using this function ensures automatic handling
-- of dependencies
--
requireAll :: (Binary a, Typeable a, Writable a)
=> Pattern
-> (b -> [a] -> c)
-> Compiler b c
requireAll pattern = requireAllA pattern . arr . uncurry
-- | Arrow-based variant of 'requireAll'
--
requireAllA :: (Binary a, Typeable a, Writable a)
=> Pattern
-> Compiler (b, [a]) c
-> Compiler b c
requireAllA pattern = (id &&& requireAll_ pattern >>>)
cached :: (Binary a, Typeable a, Writable a)
=> String
-> Compiler () a
-> Compiler () a
cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
identifier <- compilerIdentifier <$> ask
store <- compilerStore <$> ask
modified <- compilerResourceModified <$> ask
liftIO $ putStrLn $
show identifier ++ ": " ++ if modified then "MODIFIED" else "OK"
if modified
then do v <- unCompilerM $ j ()
liftIO $ storeSet store name identifier v
return v
else do v <- liftIO $ storeGet store name identifier
case v of Just v' -> return v'
Nothing -> error'
where
error' = error "Hakyll.Core.Compiler.cached: Cache corrupt!"
-- | Create an unsafe compiler from a function in IO
--
unsafeCompiler :: (a -> IO b) -- ^ Function to lift
-> Compiler a b -- ^ Resulting compiler
unsafeCompiler f = fromJob $ CompilerM . liftIO . f
|
