git.iko.soy/hakyll
on 5dba607 help sign in
hakyll/src/Hakyll/Core/Compiler/Internal.hs
156 lines 5.2 kB history raw
1-- | Internally used compiler module
2--
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4module Hakyll.Core.Compiler.Internal
5 ( Dependencies
6 , DependencyEnvironment (..)
7 , CompilerEnvironment (..)
8 , Throwing
9 , CompilerM (..)
10 , Compiler (..)
11 , runCompilerJob
12 , runCompilerDependencies
13 , fromJob
14 , fromDependencies
15 , fromDependency
16 ) where
18import Prelude hiding ((.), id)
19import Control.Applicative (Applicative, pure, (<*>), (<$>))
20import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)
21import Control.Monad.Error (ErrorT, runErrorT)
22import Control.Monad ((<=<), liftM2)
23import Data.Set (Set)
24import qualified Data.Set as S
25import Control.Category (Category, (.), id)
26import Control.Arrow (Arrow, ArrowChoice, arr, first, left)
28import Hakyll.Core.Identifier
29import Hakyll.Core.Resource.Provider
30import Hakyll.Core.Store
31import Hakyll.Core.Routes
32import Hakyll.Core.Logger
34-- | A set of dependencies
35--
36type Dependencies = Set (Identifier ())
38-- | Environment in which the dependency analyzer runs
39--
40data DependencyEnvironment = DependencyEnvironment
41 { -- | Target identifier
42 dependencyIdentifier :: Identifier ()
43 , -- | List of available identifiers we can depend upon
44 dependencyUniverse :: [Identifier ()]
45 }
47-- | Environment in which a compiler runs
48--
49data CompilerEnvironment = CompilerEnvironment
50 { -- | Target identifier
51 compilerIdentifier :: Identifier ()
52 , -- | Resource provider
53 compilerResourceProvider :: ResourceProvider
54 , -- | List of all known identifiers
55 compilerUniverse :: [Identifier ()]
56 , -- | Site routes
57 compilerRoutes :: Routes
58 , -- | Compiler store
59 compilerStore :: Store
60 , -- | Flag indicating if the underlying resource was modified
61 compilerResourceModified :: Bool
62 , -- | Logger
63 compilerLogger :: Logger
64 }
66-- | A calculation possibly throwing an error
67--
68type Throwing a = Either String a
70-- | The compiler monad
71--
72newtype CompilerM a = CompilerM
73 { unCompilerM :: ErrorT String (ReaderT CompilerEnvironment IO) a
74 } deriving (Monad, Functor, Applicative)
76-- | The compiler arrow
77--
78data Compiler a b = Compiler
79 { compilerDependencies :: Reader DependencyEnvironment Dependencies
80 , compilerJob :: a -> CompilerM b
81 }
83instance Functor (Compiler a) where
84 fmap f ~(Compiler d j) = Compiler d $ fmap f . j
86instance Applicative (Compiler a) where
87 pure = Compiler (return S.empty) . const . return
88 ~(Compiler d1 f) <*> ~(Compiler d2 j) =
89 Compiler (liftM2 S.union d1 d2) $ \x -> f x <*> j x
91instance Category Compiler where
92 id = Compiler (return S.empty) return
93 ~(Compiler d1 j1) . ~(Compiler d2 j2) =
94 Compiler (liftM2 S.union d1 d2) (j1 <=< j2)
96instance Arrow Compiler where
97 arr f = Compiler (return S.empty) (return . f)
98 first ~(Compiler d j) = Compiler d $ \(x, y) -> do
99 x' <- j x
100 return (x', y)
102instance ArrowChoice Compiler where
103 left ~(Compiler d j) = Compiler d $ \e -> case e of
104 Left l -> Left <$> j l
105 Right r -> Right <$> return r
107-- | Run a compiler, yielding the resulting target
108--
109runCompilerJob :: Compiler () a -- ^ Compiler to run
110 -> Identifier () -- ^ Target identifier
111 -> ResourceProvider -- ^ Resource provider
112 -> [Identifier ()] -- ^ Universe
113 -> Routes -- ^ Route
114 -> Store -- ^ Store
115 -> Bool -- ^ Was the resource modified?
116 -> Logger -- ^ Logger
117 -> IO (Throwing a) -- ^ Result
118runCompilerJob compiler id' provider universe route store modified logger =
119 runReaderT (runErrorT $ unCompilerM $ compilerJob compiler ()) env
120 where
121 env = CompilerEnvironment
122 { compilerIdentifier = id'
123 , compilerResourceProvider = provider
124 , compilerUniverse = universe
125 , compilerRoutes = route
126 , compilerStore = store
127 , compilerResourceModified = modified
128 , compilerLogger = logger
129 }
131runCompilerDependencies :: Compiler () a
132 -> Identifier ()
133 -> [Identifier ()]
134 -> Dependencies
135runCompilerDependencies compiler identifier universe =
136 runReader (compilerDependencies compiler) env
137 where
138 env = DependencyEnvironment
139 { dependencyIdentifier = identifier
140 , dependencyUniverse = universe
141 }
143fromJob :: (a -> CompilerM b)
144 -> Compiler a b
145fromJob = Compiler (return S.empty)
147fromDependencies :: (Identifier () -> [Identifier ()] -> [Identifier ()])
148 -> Compiler b b
149fromDependencies collectDeps = flip Compiler return $ do
150 DependencyEnvironment identifier universe <- ask
151 return $ S.fromList $ collectDeps identifier universe
153-- | Wait until another compiler has finished before running this compiler
154--
155fromDependency :: Identifier a -> Compiler b b
156fromDependency = fromDependencies . const . const . return . castIdentifier