@@ -4,26 +4,32 @@
44module Hakyll.Core.Compiler
55 ( Dependencies
66 , CompilerM
7− , Compiler
7+ , Compiler (..)
88 , runCompiler
9+ , getIdentifier
10+ , getResourceString
911 , require
10− , requireAll
11− , compileFromString
12+ -- , requireAll
13+ -- , compileFromString
1214 ) where
1315
14−import Control.Arrow (second)
16+import Prelude hiding ((.), id)
17+import Control.Arrow (second, (>>>))
1518import Control.Applicative (Applicative, (<$>))
1619import Control.Monad.State (State, modify, runState)
1720import Control.Monad.Reader (ReaderT, ask, runReaderT)
21+import Control.Monad.Trans (liftIO)
22+import Control.Monad ((<=<))
1823import Data.Set (Set)
1924import qualified Data.Set as S
20−import Data.Typeable (Typeable)
25+import Control.Category (Category, (.), id)
26+import Control.Arrow (Arrow, arr, first)
27+
2128import Data.Binary (Binary)
29+import Data.Typeable (Typeable)
2230
2331import Hakyll.Core.Identifier
2432import Hakyll.Core.Identifier.Pattern
25−import Hakyll.Core.Target
26−import Hakyll.Core.Target.Internal
2733import Hakyll.Core.CompiledItem
2834import Hakyll.Core.Writable
2935import Hakyll.Core.ResourceProvider
@@ -32,65 +38,92 @@ import Hakyll.Core.ResourceProvider
3238--
3339type Dependencies = Set Identifier
3440
35−-- | Add one dependency
41+-- | A lookup with which we can get dependencies
3642--
37−addDependency :: Identifier -> CompilerM ()
38−addDependency dependency = CompilerM $ modify $ addDependency'
39− where
40− addDependency' x = x
41− { compilerDependencies = S.insert dependency $ compilerDependencies x
42− }
43+type DependencyLookup = Identifier -> CompiledItem
4344
4445-- | Environment in which a compiler runs
4546--
4647data CompilerEnvironment = CompilerEnvironment
4748 { compilerIdentifier :: Identifier -- ^ Target identifier
4849 , compilerResourceProvider :: ResourceProvider -- ^ Resource provider
49− }
50−
51−-- | State carried along by a compiler
52−--
53−data CompilerState = CompilerState
54− { compilerDependencies :: Dependencies
50+ , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup
5551 }
5652
5753-- | The compiler monad
5854--
5955newtype CompilerM a = CompilerM
60− { unCompilerM :: ReaderT CompilerEnvironment (State CompilerState) a
56+ { unCompilerM :: ReaderT CompilerEnvironment IO a
6157 } deriving (Monad, Functor, Applicative)
6258
63−-- | Simplified type for a compiler generating a target (which covers most
64−-- cases)
59+-- | The compiler arrow
6560--
66−type Compiler a = CompilerM (TargetM a)
61+data Compiler a b = Compiler
62+ { -- TODO: Reader ResourceProvider Dependencies
63+ compilerDependencies :: Dependencies
64+ , compilerJob :: a -> CompilerM b
65+ }
66+
67+instance Category Compiler where
68+ id = Compiler S.empty return
69+ (Compiler d1 j1) . (Compiler d2 j2) =
70+ Compiler (d1 `S.union` d2) (j1 <=< j2)
71+
72+instance Arrow Compiler where
73+ arr f = Compiler S.empty (return . f)
74+ first (Compiler d j) = Compiler d $ \(x, y) -> do
75+ x' <- j x
76+ return (x', y)
6777
6878-- | Run a compiler, yielding the resulting target and it's dependencies
6979--
70−runCompiler :: Compiler a -> Identifier -> ResourceProvider
71− -> (TargetM a, Dependencies)
72−runCompiler compiler identifier provider = second compilerDependencies $
73− runState (runReaderT (unCompilerM compiler) env) state
80+runCompiler :: Compiler () a
81+ -> Identifier
82+ -> ResourceProvider
83+ -> DependencyLookup
84+ -> IO a
85+runCompiler compiler identifier provider lookup' =
86+ runReaderT (unCompilerM $ compilerJob compiler ()) env
7487 where
75− state = CompilerState S.empty
7688 env = CompilerEnvironment
7789 { compilerIdentifier = identifier
7890 , compilerResourceProvider = provider
91+ , compilerDependencyLookup = lookup'
7992 }
8093
94+addDependency :: Identifier
95+ -> Compiler b b
96+addDependency id' = Compiler (S.singleton id') return
97+
98+fromCompilerM :: (a -> CompilerM b)
99+ -> Compiler a b
100+fromCompilerM = Compiler S.empty
101+
102+getIdentifier :: Compiler () Identifier
103+getIdentifier = fromCompilerM $ const $ CompilerM $
104+ compilerIdentifier <$> ask
105+
106+getResourceString :: Compiler () String
107+getResourceString = getIdentifier >>> getResourceString'
108+ where
109+ getResourceString' = fromCompilerM $ \id' -> CompilerM $ do
110+ provider <- compilerResourceProvider <$> ask
111+ liftIO $ resourceString provider id'
81112
82113-- | Require another target. Using this function ensures automatic handling of
83114-- dependencies
84115--
85116require :: (Binary a, Typeable a, Writable a)
86117 => Identifier
87− -> Compiler a
88−require identifier = do
89− addDependency identifier
90− return $ TargetM $ do
91− lookup' <- targetDependencyLookup <$> ask
92− return $ unCompiledItem $ lookup' identifier
118+ -> (a -> b -> c)
119+ -> Compiler b c
120+require identifier f = addDependency identifier >>> fromCompilerM require'
121+ where
122+ require' x = CompilerM $ do
123+ lookup' <- compilerDependencyLookup <$> ask
124+ return $ f (unCompiledItem $ lookup' identifier) x
93125
126+{-
94127-- | Require a number of targets. Using this function ensures automatic handling
95128-- of dependencies
96129--
@@ -108,3 +141,4 @@ requireAll pattern = CompilerM $ do
108141compileFromString :: (String -> TargetM a) -- ^ Function to create the target
109142 -> Compiler a -- ^ Resulting compiler
110143compileFromString = return . (getResourceString >>=)
144+-}