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
|
-- | This module provides a monadic DSL in which the user can specify the
-- different rules used to run the compilers
--
{-# LANGUAGE GeneralizedNewtypeDeriving, OverloadedStrings #-}
module Hakyll.Core.Rules
( CompileRule (..)
, RuleSet (..)
, RulesM
, Rules
, runRules
, compile
, create
, route
, metaCompile
, metaCompileWith
) where
import Control.Applicative (Applicative, (<$>))
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Arrow (second, (>>>), arr, (>>^))
import Control.Monad.State
import Data.Typeable (Typeable)
import Data.Binary (Binary)
import Hakyll.Core.ResourceProvider
import Hakyll.Core.Identifier
import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.Compiler.Internal
import Hakyll.Core.Routes
import Hakyll.Core.CompiledItem
import Hakyll.Core.Writable
-- | Output of a compiler rule
--
-- * The compiler will produce a simple item. This is the most common case.
--
-- * The compiler will produce more compilers. These new compilers need to be
-- added to the runtime if possible, since other items might depend upon them.
--
data CompileRule = CompileRule CompiledItem
| MetaCompileRule [(Identifier, Compiler () CompileRule)]
-- | A collection of rules for the compilation process
--
data RuleSet = RuleSet
{ rulesRoutes :: Routes
, rulesCompilers :: [(Identifier, Compiler () CompileRule)]
}
instance Monoid RuleSet where
mempty = RuleSet mempty mempty
mappend (RuleSet r1 c1) (RuleSet r2 c2) =
RuleSet (mappend r1 r2) (mappend c1 c2)
-- | Rule state
--
data RuleState = RuleState
{ rulesMetaCompilerIndex :: Int
} deriving (Show)
-- | The monad used to compose rules
--
newtype RulesM a = RulesM
{ unRulesM :: ReaderT ResourceProvider (WriterT RuleSet (State RuleState)) a
} deriving (Monad, Functor, Applicative)
-- | Simplification of the RulesM type; usually, it will not return any
-- result.
--
type Rules = RulesM ()
-- | Run a Rules monad, resulting in a 'RuleSet'
--
runRules :: Rules -> ResourceProvider -> RuleSet
runRules rules provider =
evalState (execWriterT $ runReaderT (unRulesM rules) provider) state
where
state = RuleState {rulesMetaCompilerIndex = 0}
-- | Add a route
--
tellRoute :: Routes -> Rules
tellRoute route' = RulesM $ tell $ RuleSet route' mempty
-- | Add a number of compilers
--
tellCompilers :: (Binary a, Typeable a, Writable a)
=> [(Identifier, Compiler () a)]
-> Rules
tellCompilers compilers = RulesM $ tell $ RuleSet mempty $
map (second boxCompiler) compilers
where
boxCompiler = (>>> arr compiledItem >>> arr CompileRule)
-- | Add a compilation rule
--
-- This instructs all resources matching the given pattern to be compiled using
-- the given compiler
--
compile :: (Binary a, Typeable a, Writable a)
=> Pattern -> Compiler () a -> Rules
compile pattern compiler = RulesM $ do
identifiers <- matches pattern . resourceList <$> ask
unRulesM $ tellCompilers $ zip identifiers (repeat compiler)
-- | Add a compilation rule
--
-- This sets a compiler for the given identifier
--
create :: (Binary a, Typeable a, Writable a)
=> Identifier -> Compiler () a -> Rules
create identifier compiler = tellCompilers [(identifier, compiler)]
-- | Add a route
--
route :: Pattern -> Routes -> Rules
route pattern route' = tellRoute $ ifMatch pattern route'
-- | Add a compiler that produces other compilers over time
--
metaCompile :: (Binary a, Typeable a, Writable a)
=> Compiler () [(Identifier, Compiler () a)]
-- ^ Compiler generating the other compilers
-> Rules
-- ^ Resulting rules
metaCompile compiler = RulesM $ do
-- Create an identifier from the state
state <- get
let index = rulesMetaCompilerIndex state
id' = fromCaptureString "Hakyll.Core.Rules.metaCompile/*" (show index)
-- Update the state with a new identifier
put $ state {rulesMetaCompilerIndex = index + 1}
-- Fallback to 'metaCompileWith' with now known identifier
unRulesM $ metaCompileWith id' compiler
-- | Version of 'metaCompile' that allows you to specify a custom identifier for
-- the metacompiler.
--
metaCompileWith :: (Binary a, Typeable a, Writable a)
=> Identifier
-- ^ Identifier for this compiler
-> Compiler () [(Identifier, Compiler () a)]
-- ^ Compiler generating the other compilers
-> Rules
-- ^ Resulting rules
metaCompileWith identifier compiler = RulesM $ tell $ RuleSet mempty
[(identifier, compiler >>> arr makeRule )]
where
makeRule = MetaCompileRule . map (second box)
box = (>>> fromDependency identifier >>^ CompileRule . compiledItem)
|
