git.iko.soy/hakyll
on f104f91 help sign in
hakyll/src/Hakyll/Core/Compiler.hs
151 lines 5.2 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 , fromDependency
11 , require
12 , requireAll
13 , cached
14 , unsafeCompiler
15 ) where
17import Prelude hiding ((.), id)
18import Control.Arrow ((>>>))
19import Control.Applicative ((<$>))
20import Control.Monad.Reader (ask)
21import Control.Monad.Trans (liftIO)
22import Control.Category (Category, (.))
23import Data.Maybe (fromMaybe)
25import Data.Binary (Binary)
26import Data.Typeable (Typeable)
28import Hakyll.Core.Identifier
29import Hakyll.Core.Identifier.Pattern
30import Hakyll.Core.CompiledItem
31import Hakyll.Core.Writable
32import Hakyll.Core.ResourceProvider
33import Hakyll.Core.Compiler.Internal
34import Hakyll.Core.Store
35import Hakyll.Core.Rules
37-- | Run a compiler, yielding the resulting target and it's dependencies. This
38-- version of 'runCompilerJob' also stores the result
39--
40runCompiler :: Compiler () CompileRule -- ^ Compiler to run
41 -> Identifier -- ^ Target identifier
42 -> ResourceProvider -- ^ Resource provider
43 -> Maybe FilePath -- ^ Route
44 -> Store -- ^ Store
45 -> Bool -- ^ Was the resource modified?
46 -> IO CompileRule -- ^ Resulting item
47runCompiler compiler identifier provider route' store modified = do
48 -- Run the compiler job
49 result <- runCompilerJob compiler identifier provider route' store modified
51 -- Inspect the result
52 case result of
53 -- In case we compiled an item, we will store a copy in the cache first,
54 -- before we return control. This makes sure the compiled item can later
55 -- be accessed by e.g. require.
56 CompileRule (CompiledItem x) ->
57 storeSet store "Hakyll.Core.Compiler.runCompiler" identifier x
59 -- Otherwise, we do nothing here
60 _ -> return ()
62 return result
64-- | Get the identifier of the item that is currently being compiled
65--
66getIdentifier :: Compiler a Identifier
67getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask
69-- | Get the route we are using for this item
70--
71getRoute :: Compiler a (Maybe FilePath)
72getRoute = fromJob $ const $ CompilerM $ compilerRoute <$> ask
74-- | Get the resource we are compiling as a string
75--
76getResourceString :: Compiler a String
77getResourceString = getIdentifier >>> getResourceString'
78 where
79 getResourceString' = fromJob $ \id' -> CompilerM $ do
80 provider <- compilerResourceProvider <$> ask
81 liftIO $ resourceString provider id'
83-- | Auxiliary: get a dependency
84--
85getDependency :: (Binary a, Writable a, Typeable a)
86 => Identifier -> CompilerM a
87getDependency identifier = CompilerM $ do
88 store <- compilerStore <$> ask
89 fmap (fromMaybe error') $ liftIO $
90 storeGet store "Hakyll.Core.Compiler.runCompiler" identifier
91 where
92 error' = error $ "Hakyll.Core.Compiler.getDependency: "
93 ++ show identifier
94 ++ " not found in the cache, the cache might be corrupted or"
95 ++ " the item you are referring to might not exist"
97-- | Require another target. Using this function ensures automatic handling of
98-- dependencies
99--
100require :: (Binary a, Typeable a, Writable a)
101 => Identifier
102 -> (b -> a -> c)
103 -> Compiler b c
104require identifier f =
105 fromDependency identifier >>> fromJob require'
106 where
107 require' x = do
108 y <- getDependency identifier
109 return $ f x y
111-- | Require a number of targets. Using this function ensures automatic handling
112-- of dependencies
113--
114requireAll :: (Binary a, Typeable a, Writable a)
115 => Pattern
116 -> (b -> [a] -> c)
117 -> Compiler b c
118requireAll pattern f =
119 fromDependencies getDeps >>> fromJob requireAll'
120 where
121 getDeps = matches pattern . resourceList
122 requireAll' x = CompilerM $ do
123 deps <- getDeps . compilerResourceProvider <$> ask
124 items <- mapM (unCompilerM . getDependency) deps
125 return $ f x items
127cached :: (Binary a, Typeable a, Writable a)
128 => String
129 -> Compiler () a
130 -> Compiler () a
131cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
132 identifier <- compilerIdentifier <$> ask
133 store <- compilerStore <$> ask
134 modified <- compilerResourceModified <$> ask
135 liftIO $ putStrLn $
136 show identifier ++ ": " ++ if modified then "MODIFIED" else "OK"
137 if modified
138 then do v <- unCompilerM $ j ()
139 liftIO $ storeSet store name identifier v
140 return v
141 else do v <- liftIO $ storeGet store name identifier
142 case v of Just v' -> return v'
143 Nothing -> error'
144 where
145 error' = error "Hakyll.Core.Compiler.cached: Cache corrupt!"
147-- | Create an unsafe compiler from a function in IO
148--
149unsafeCompiler :: (a -> IO b) -- ^ Function to lift
150 -> Compiler a b -- ^ Resulting compiler
151unsafeCompiler f = fromJob $ CompilerM . liftIO . f