on master help sign in
Compiler → {Compiler, Compiler.Internal}
commitda12825066d16884bae2f884029102919dd9a558 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 30 Dec 2010, 17:47 (16 years ago) parent227b186
3 files changed+109−90
src/Hakyll/Core/Compiler.hs+10−88 src/Hakyll/Core/Compiler/Internal.hs+96 src/Hakyll/Core/Run.hs+3−2
src/Hakyll/Core/Compiler.hs+10−88
@@ -2,11 +2,7 @@
22--
33{-# LANGUAGE GeneralizedNewtypeDeriving #-}
44module Hakyll.Core.Compiler
5− ( Dependencies
6− , CompilerM
7− , Compiler (..)
8− , runCompiler
9− , getDependencies
5+ ( Compiler
106 , getIdentifier
117 , getResourceString
128 , require
@@ -14,16 +10,11 @@ module Hakyll.Core.Compiler
1410 ) where
1511
1612import Prelude hiding ((.), id)
17−import Control.Arrow (second, (>>>))
18−import Control.Applicative (Applicative, (<$>))
19−import Control.Monad.State (State, modify, runState)
20−import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)
13+import Control.Arrow ((>>>))
14+import Control.Applicative ((<$>))
15+import Control.Monad.Reader (ask)
2116import Control.Monad.Trans (liftIO)
22−import Control.Monad ((<=<), liftM2)
23−import Data.Set (Set)
24−import qualified Data.Set as S
25−import Control.Category (Category, (.), id)
26−import Control.Arrow (Arrow, arr, first)
17+import Control.Category (Category, (.))
2718
2819import Data.Binary (Binary)
2920import Data.Typeable (Typeable)
@@ -33,85 +24,16 @@ import Hakyll.Core.Identifier.Pattern
3324import Hakyll.Core.CompiledItem
3425import Hakyll.Core.Writable
3526import Hakyll.Core.ResourceProvider
36−
37−-- | A set of dependencies
38−--
39−type Dependencies = Set Identifier
40−
41−-- | A lookup with which we can get dependencies
42−--
43−type DependencyLookup = Identifier -> CompiledItem
44−
45−-- | Environment in which a compiler runs
46−--
47−data CompilerEnvironment = CompilerEnvironment
48− { compilerIdentifier :: Identifier -- ^ Target identifier
49− , compilerResourceProvider :: ResourceProvider -- ^ Resource provider
50− , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup
51− }
52−
53−-- | The compiler monad
54−--
55−newtype CompilerM a = CompilerM
56− { unCompilerM :: ReaderT CompilerEnvironment IO a
57− } deriving (Monad, Functor, Applicative)
58−
59−-- | The compiler arrow
60−--
61−data Compiler a b = Compiler
62− { compilerDependencies :: Reader ResourceProvider Dependencies
63− , compilerJob :: a -> CompilerM b
64− }
65−
66−instance Category Compiler where
67− id = Compiler (return S.empty) return
68− (Compiler d1 j1) . (Compiler d2 j2) =
69− Compiler (liftM2 S.union d1 d2) (j1 <=< j2)
70−
71−instance Arrow Compiler where
72− arr f = Compiler (return S.empty) (return . f)
73− first (Compiler d j) = Compiler d $ \(x, y) -> do
74− x' <- j x
75− return (x', y)
76−
77−-- | Run a compiler, yielding the resulting target and it's dependencies
78−--
79−runCompiler :: Compiler () a
80− -> Identifier
81− -> ResourceProvider
82− -> DependencyLookup
83− -> IO a
84−runCompiler compiler identifier provider lookup' =
85− runReaderT (unCompilerM $ compilerJob compiler ()) env
86− where
87− env = CompilerEnvironment
88− { compilerIdentifier = identifier
89− , compilerResourceProvider = provider
90− , compilerDependencyLookup = lookup'
91− }
92−
93−getDependencies :: Compiler () a
94− -> ResourceProvider
95− -> Dependencies
96−getDependencies compiler provider =
97− runReader (compilerDependencies compiler) provider
98−
99−addDependencies :: (ResourceProvider -> [Identifier])
100− -> Compiler b b
101−addDependencies deps = Compiler (S.fromList . deps <$> ask) return
102−
103−fromCompilerM :: (a -> CompilerM b)
104− -> Compiler a b
105−fromCompilerM = Compiler (return S.empty)
27+import Hakyll.Core.Compiler.Internal
10628
10729getIdentifier :: Compiler a Identifier
108−getIdentifier = fromCompilerM $ const $ CompilerM $
30+getIdentifier = fromJob $ const $ CompilerM $
10931 compilerIdentifier <$> ask
11032
11133getResourceString :: Compiler a String
11234getResourceString = getIdentifier >>> getResourceString'
11335 where
114− getResourceString' = fromCompilerM $ \id' -> CompilerM $ do
36+ getResourceString' = fromJob $ \id' -> CompilerM $ do
11537 provider <- compilerResourceProvider <$> ask
11638 liftIO $ resourceString provider id'
11739
@@ -123,7 +45,7 @@ require :: (Binary a, Typeable a, Writable a)
12345 -> (b -> a -> c)
12446 -> Compiler b c
12547require identifier f =
126− addDependencies (const [identifier]) >>> fromCompilerM require'
48+ fromDependencies (const [identifier]) >>> fromJob require'
12749 where
12850 require' x = CompilerM $ do
12951 lookup' <- compilerDependencyLookup <$> ask
@@ -137,7 +59,7 @@ requireAll :: (Binary a, Typeable a, Writable a)
13759 -> (b -> [a] -> c)
13860 -> Compiler b c
13961requireAll pattern f =
140− addDependencies getDeps >>> fromCompilerM requireAll'
62+ fromDependencies getDeps >>> fromJob requireAll'
14163 where
14264 getDeps = matches pattern . resourceList
14365 requireAll' x = CompilerM $ do
src/Hakyll/Core/Compiler/Internal.hsnew file+96
@@ -0,0 +1,96 @@
1+-- | Internally used compiler module
2+--
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+module Hakyll.Core.Compiler.Internal
5+ ( Dependencies
6+ , CompilerEnvironment (..)
7+ , CompilerM (..)
8+ , Compiler (..)
9+ , runCompilerJob
10+ , runCompilerDependencies
11+ , fromJob
12+ , fromDependencies
13+ ) where
14+
15+import Prelude hiding ((.), id)
16+import Control.Applicative (Applicative, (<$>))
17+import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)
18+import Control.Monad ((<=<), liftM2)
19+import Data.Set (Set)
20+import qualified Data.Set as S
21+import Control.Category (Category, (.), id)
22+import Control.Arrow (Arrow, arr, first)
23+
24+import Hakyll.Core.Identifier
25+import Hakyll.Core.CompiledItem
26+import Hakyll.Core.ResourceProvider
27+
28+-- | A set of dependencies
29+--
30+type Dependencies = Set Identifier
31+
32+-- | A lookup with which we can get dependencies
33+--
34+type DependencyLookup = Identifier -> CompiledItem
35+
36+-- | Environment in which a compiler runs
37+--
38+data CompilerEnvironment = CompilerEnvironment
39+ { compilerIdentifier :: Identifier -- ^ Target identifier
40+ , compilerResourceProvider :: ResourceProvider -- ^ Resource provider
41+ , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup
42+ }
43+
44+-- | The compiler monad
45+--
46+newtype CompilerM a = CompilerM
47+ { unCompilerM :: ReaderT CompilerEnvironment IO a
48+ } deriving (Monad, Functor, Applicative)
49+
50+-- | The compiler arrow
51+--
52+data Compiler a b = Compiler
53+ { compilerDependencies :: Reader ResourceProvider Dependencies
54+ , compilerJob :: a -> CompilerM b
55+ }
56+
57+instance Category Compiler where
58+ id = Compiler (return S.empty) return
59+ (Compiler d1 j1) . (Compiler d2 j2) =
60+ Compiler (liftM2 S.union d1 d2) (j1 <=< j2)
61+
62+instance Arrow Compiler where
63+ arr f = Compiler (return S.empty) (return . f)
64+ first (Compiler d j) = Compiler d $ \(x, y) -> do
65+ x' <- j x
66+ return (x', y)
67+
68+-- | Run a compiler, yielding the resulting target and it's dependencies
69+--
70+runCompilerJob :: Compiler () a
71+ -> Identifier
72+ -> ResourceProvider
73+ -> DependencyLookup
74+ -> IO a
75+runCompilerJob compiler identifier provider lookup' =
76+ runReaderT (unCompilerM $ compilerJob compiler ()) env
77+ where
78+ env = CompilerEnvironment
79+ { compilerIdentifier = identifier
80+ , compilerResourceProvider = provider
81+ , compilerDependencyLookup = lookup'
82+ }
83+
84+runCompilerDependencies :: Compiler () a
85+ -> ResourceProvider
86+ -> Dependencies
87+runCompilerDependencies compiler provider =
88+ runReader (compilerDependencies compiler) provider
89+
90+fromJob :: (a -> CompilerM b)
91+ -> Compiler a b
92+fromJob = Compiler (return S.empty)
93+
94+fromDependencies :: (ResourceProvider -> [Identifier])
95+ -> Compiler b b
96+fromDependencies deps = Compiler (S.fromList . deps <$> ask) return
src/Hakyll/Core/Run.hs+3−2
@@ -14,6 +14,7 @@ import Hakyll.Core.Route
1414import Hakyll.Core.Identifier
1515import Hakyll.Core.Util.File
1616import Hakyll.Core.Compiler
17+import Hakyll.Core.Compiler.Internal
1718import Hakyll.Core.ResourceProvider
1819import Hakyll.Core.ResourceProvider.FileResourceProvider
1920import Hakyll.Core.Rules
@@ -40,7 +41,7 @@ hakyllWith rules provider store = do
4041
4142 -- Get all dependencies
4243 dependencies = flip map compilers $ \(id', compiler) ->
43− let deps = getDependencies compiler provider
44+ let deps = runCompilerDependencies compiler provider
4445 in (id', deps)
4546
4647 -- Create a compiler map
@@ -65,7 +66,7 @@ hakyllWith rules provider store = do
6566 putStrLn "DONE."
6667 where
6768 addTarget route' map' (id', comp) = do
68− compiled <- runCompiler comp id' provider (dependencyLookup map')
69+ compiled <- runCompilerJob comp id' provider (dependencyLookup map')
6970 putStrLn $ "Generated target: " ++ show id'
7071
7172 case runRoute route' id' of