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
|
-- | Internally used compiler module
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Compiler.Internal
( Dependencies
, CompilerEnvironment (..)
, CompilerM (..)
, Compiler (..)
, runCompilerJob
, runCompilerDependencies
, fromJob
, fromDependencies
, fromDependency
) where
import Prelude hiding ((.), id)
import Control.Applicative (Applicative, pure, (<*>), (<$>))
import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)
import Control.Monad ((<=<), liftM2)
import Data.Set (Set)
import qualified Data.Set as S
import Control.Category (Category, (.), id)
import Control.Arrow (Arrow, ArrowChoice, arr, first, left)
import Hakyll.Core.Identifier
import Hakyll.Core.ResourceProvider
import Hakyll.Core.Store
import Hakyll.Core.Routes
-- | A set of dependencies
--
type Dependencies = Set Identifier
-- | Environment in which a compiler runs
--
data CompilerEnvironment = CompilerEnvironment
{ -- | Target identifier
compilerIdentifier :: Identifier
, -- | Resource provider
compilerResourceProvider :: ResourceProvider
, -- | Site routes
compilerRoutes :: Routes
, -- | Compiler store
compilerStore :: Store
, -- | Flag indicating if the underlying resource was modified
compilerResourceModified :: Bool
}
-- | 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 Functor (Compiler a) where
fmap f ~(Compiler d j) = Compiler d $ fmap f . j
instance Applicative (Compiler a) where
pure = Compiler (return S.empty) . const . return
~(Compiler d1 f) <*> ~(Compiler d2 j) =
Compiler (liftM2 S.union d1 d2) $ \x -> f x <*> j x
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)
instance ArrowChoice Compiler where
left ~(Compiler d j) = Compiler d $ \e -> case e of
Left l -> Left <$> j l
Right r -> Right <$> return r
-- | Run a compiler, yielding the resulting target and it's dependencies
--
runCompilerJob :: Compiler () a -- ^ Compiler to run
-> Identifier -- ^ Target identifier
-> ResourceProvider -- ^ Resource provider
-> Routes -- ^ Route
-> Store -- ^ Store
-> Bool -- ^ Was the resource modified?
-> IO a
runCompilerJob compiler identifier provider route store modified =
runReaderT (unCompilerM $ compilerJob compiler ()) env
where
env = CompilerEnvironment
{ compilerIdentifier = identifier
, compilerResourceProvider = provider
, compilerRoutes = route
, compilerStore = store
, compilerResourceModified = modified
}
runCompilerDependencies :: Compiler () a
-> ResourceProvider
-> Dependencies
runCompilerDependencies compiler = runReader (compilerDependencies compiler)
fromJob :: (a -> CompilerM b)
-> Compiler a b
fromJob = Compiler (return S.empty)
fromDependencies :: (ResourceProvider -> [Identifier])
-> Compiler b b
fromDependencies deps = Compiler (S.fromList . deps <$> ask) return
-- | Wait until another compiler has finished before running this compiler
--
fromDependency :: Identifier -> Compiler a a
fromDependency = fromDependencies . const . return
|
