on ddb8ea2 help sign in
hakyll/src/Hakyll/Core/Compiler.hs
148 lines 5.0 kB history raw
1-- | A Compiler manages targets and dependencies between targets.
2--
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4module Hakyll.Core.Compiler
5 ( Compiler
6 , runCompiler
7 , getIdentifier
8 , getRoute
9 , getResourceString
10 , waitFor
11 , require
12 , requireAll
13 , cached
14 ) where
16import Prelude hiding ((.), id)
17import Control.Arrow ((>>>))
18import Control.Applicative ((<$>))
19import Control.Monad.Reader (ask)
20import Control.Monad.Trans (liftIO)
21import Control.Category (Category, (.))
22import Data.Maybe (fromMaybe)
24import Data.Binary (Binary)
25import Data.Typeable (Typeable)
27import Hakyll.Core.Identifier
28import Hakyll.Core.Identifier.Pattern
29import Hakyll.Core.CompiledItem
30import Hakyll.Core.Writable
31import Hakyll.Core.ResourceProvider
32import Hakyll.Core.Compiler.Internal
33import Hakyll.Core.Store
34import Hakyll.Core.Rules
36-- | Run a compiler, yielding the resulting target and it's dependencies. This
37-- version of 'runCompilerJob' also stores the result
38--
39runCompiler :: Compiler () CompileRule -- ^ Compiler to run
40 -> Identifier -- ^ Target identifier
41 -> ResourceProvider -- ^ Resource provider
42 -> Maybe FilePath -- ^ Route
43 -> Store -- ^ Store
44 -> Bool -- ^ Was the resource modified?
45 -> IO CompileRule -- ^ Resulting item
46runCompiler compiler identifier provider route' store modified = do
47 -- Run the compiler job
48 result <- runCompilerJob compiler identifier provider route' store modified
50 -- Inspect the result
51 case result of
52 -- In case we compiled an item, we will store a copy in the cache first,
53 -- before we return control. This makes sure the compiled item can later
54 -- be accessed by e.g. require.
55 CompileRule (CompiledItem x) ->
56 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
58 -- Otherwise, we do nothing here
59 _ -> return ()
61 return result
63-- | Get the identifier of the item that is currently being compiled
64--
65getIdentifier :: Compiler a Identifier
66getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask
68-- | Get the route we are using for this item
69--
70getRoute :: Compiler a (Maybe FilePath)
71getRoute = fromJob $ const $ CompilerM $ compilerRoute <$> ask
73-- | Get the resource we are compiling as a string
74--
75getResourceString :: Compiler a String
76getResourceString = getIdentifier >>> getResourceString'
77 where
78 getResourceString' = fromJob $ \id' -> CompilerM $ do
79 provider <- compilerResourceProvider <$> ask
80 liftIO $ resourceString provider id'
82-- | Auxiliary: get a dependency
83--
84getDependency :: (Binary a, Writable a, Typeable a)
85 => Identifier -> CompilerM a
86getDependency identifier = CompilerM $ do
87 store <- compilerStore <$> ask
88 fmap (fromMaybe error') $ liftIO $
89 storeGet store "Hakyll.Core.Compiler.runCompiler" identifier
90 where
91 error' = error $ "Hakyll.Core.Compiler.getDependency: "
92 ++ show identifier
93 ++ " not found in the cache, the cache might be corrupted"
95-- | Wait until another compiler has finished before running this compiler
96--
97waitFor :: Identifier -> Compiler a a
98waitFor = fromDependencies . const . return
100-- | Require another target. Using this function ensures automatic handling of
101-- dependencies
102--
103require :: (Binary a, Typeable a, Writable a)
104 => Identifier
105 -> (b -> a -> c)
106 -> Compiler b c
107require identifier f =
108 waitFor identifier >>> fromJob require'
109 where
110 require' x = do
111 y <- getDependency identifier
112 return $ f x y
114-- | Require a number of targets. Using this function ensures automatic handling
115-- of dependencies
116--
117requireAll :: (Binary a, Typeable a, Writable a)
118 => Pattern
119 -> (b -> [a] -> c)
120 -> Compiler b c
121requireAll pattern f =
122 fromDependencies getDeps >>> fromJob requireAll'
123 where
124 getDeps = matches pattern . resourceList
125 requireAll' x = CompilerM $ do
126 deps <- getDeps . compilerResourceProvider <$> ask
127 items <- mapM (unCompilerM . getDependency) deps
128 return $ f x items
130cached :: (Binary a, Typeable a, Writable a)
131 => String
132 -> Compiler () a
133 -> Compiler () a
134cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
135 identifier <- compilerIdentifier <$> ask
136 store <- compilerStore <$> ask
137 modified <- compilerResourceModified <$> ask
138 liftIO $ putStrLn $
139 show identifier ++ ": " ++ if modified then "MODIFIED" else "OK"
140 if modified
141 then do v <- unCompilerM $ j ()
142 liftIO $ storeSet store name identifier v
143 return v
144 else do v <- liftIO $ storeGet store name identifier
145 case v of Just v' -> return v'
146 Nothing -> error'
147 where
148 error' = error "Hakyll.Core.Compiler.cached: Cache corrupt!"