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
|
-- | A Compiler manages targets and dependencies between targets.
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Compiler
( Dependencies
, CompilerM
, Compiler (..)
, runCompiler
, getDependencies
, getIdentifier
, getResourceString
, require
, requireAll
-- , compileFromString
) where
import Prelude hiding ((.), id)
import Control.Arrow (second, (>>>))
import Control.Applicative (Applicative, (<$>))
import Control.Monad.State (State, modify, runState)
import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)
import Control.Monad.Trans (liftIO)
import Control.Monad ((<=<), liftM2)
import Data.Set (Set)
import qualified Data.Set as S
import Control.Category (Category, (.), id)
import Control.Arrow (Arrow, arr, first)
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
-- | A set of dependencies
--
type Dependencies = Set Identifier
-- | A lookup with which we can get dependencies
--
type DependencyLookup = Identifier -> CompiledItem
-- | Environment in which a compiler runs
--
data CompilerEnvironment = CompilerEnvironment
{ compilerIdentifier :: Identifier -- ^ Target identifier
, compilerResourceProvider :: ResourceProvider -- ^ Resource provider
, compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup
}
-- | The compiler monad
--
newtype CompilerM a = CompilerM
{ unCompilerM :: ReaderT CompilerEnvironment IO a
} deriving (Monad, Functor, Applicative)
-- | The compiler arrow
--
data Compiler a b = Compiler
{ compilerDependencies :: Reader ResourceProvider Dependencies
, compilerJob :: a -> CompilerM b
}
instance Category Compiler where
id = Compiler (return S.empty) return
(Compiler d1 j1) . (Compiler d2 j2) =
Compiler (liftM2 S.union d1 d2) (j1 <=< j2)
instance Arrow Compiler where
arr f = Compiler (return S.empty) (return . f)
first (Compiler d j) = Compiler d $ \(x, y) -> do
x' <- j x
return (x', y)
-- | Run a compiler, yielding the resulting target and it's dependencies
--
runCompiler :: Compiler () a
-> Identifier
-> ResourceProvider
-> DependencyLookup
-> IO a
runCompiler compiler identifier provider lookup' =
runReaderT (unCompilerM $ compilerJob compiler ()) env
where
env = CompilerEnvironment
{ compilerIdentifier = identifier
, compilerResourceProvider = provider
, compilerDependencyLookup = lookup'
}
getDependencies :: Compiler () a
-> ResourceProvider
-> Dependencies
getDependencies compiler provider =
runReader (compilerDependencies compiler) provider
addDependencies :: (ResourceProvider -> [Identifier])
-> Compiler b b
addDependencies deps = Compiler (S.fromList . deps <$> ask) return
fromCompilerM :: (a -> CompilerM b)
-> Compiler a b
fromCompilerM = Compiler (return S.empty)
getIdentifier :: Compiler a Identifier
getIdentifier = fromCompilerM $ const $ CompilerM $
compilerIdentifier <$> ask
getResourceString :: Compiler a String
getResourceString = getIdentifier >>> getResourceString'
where
getResourceString' = fromCompilerM $ \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 =
addDependencies (const [identifier]) >>> fromCompilerM 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 =
addDependencies getDeps >>> fromCompilerM requireAll'
where
getDeps = matches pattern . resourceList
requireAll' x = CompilerM $ do
deps <- getDeps . compilerResourceProvider <$> ask
lookup' <- compilerDependencyLookup <$> ask
return $ f x $ map (unCompiledItem . lookup') deps
{-
-- | Construct a target from a string, this string being the content of the
-- resource.
--
compileFromString :: (String -> TargetM a) -- ^ Function to create the target
-> Compiler a -- ^ Resulting compiler
compileFromString = return . (getResourceString >>=)
-}
|
