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
|
-- | A Compiler manages targets and dependencies between targets.
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Compiler
( Compiler
, getIdentifier
, getRoute
, getResourceString
, require
, requireAll
, cached
) where
import Prelude hiding ((.), id)
import Control.Arrow ((>>>))
import Control.Applicative ((<$>))
import Control.Monad.Reader (ask)
import Control.Monad.Trans (liftIO)
import Control.Category (Category, (.))
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
-- | 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 $ compilerRoute <$> ask
-- | 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'
-- | 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 f =
fromDependencies (const [identifier]) >>> fromJob require'
where
require' x = CompilerM $ do
lookup' <- compilerDependencyLookup <$> ask
return $ f x $ unCompiledItem $ lookup' identifier
-- | 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 f =
fromDependencies getDeps >>> fromJob requireAll'
where
getDeps = matches pattern . resourceList
requireAll' x = CompilerM $ do
deps <- getDeps . compilerResourceProvider <$> ask
lookup' <- compilerDependencyLookup <$> ask
return $ f x $ map (unCompiledItem . lookup') deps
cached :: (Binary a)
=> String
-> Compiler () a
-> Compiler () a
cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
provider <- compilerResourceProvider <$> ask
identifier <- compilerIdentifier <$> ask
store <- compilerStore <$> ask
modified <- liftIO $ resourceModified provider identifier store
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!"
|
