summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core/Compiler.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Hakyll/Core/Compiler.hs')
-rw-r--r--src/Hakyll/Core/Compiler.hs98
1 files changed, 10 insertions, 88 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index 7837991..d0e219e 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -2,11 +2,7 @@
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Hakyll.Core.Compiler
- ( Dependencies
- , CompilerM
- , Compiler (..)
- , runCompiler
- , getDependencies
+ ( Compiler
, getIdentifier
, getResourceString
, require
@@ -14,16 +10,11 @@ module Hakyll.Core.Compiler
) where
import Prelude hiding ((.), id)
-import Control.Arrow (second, (>>>))
-import Control.Applicative (Applicative, (<$>))
-import Control.Monad.State (State, modify, runState)
-import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)
+import Control.Arrow ((>>>))
+import Control.Applicative ((<$>))
+import Control.Monad.Reader (ask)
import Control.Monad.Trans (liftIO)
-import Control.Monad ((<=<), liftM2)
-import Data.Set (Set)
-import qualified Data.Set as S
-import Control.Category (Category, (.), id)
-import Control.Arrow (Arrow, arr, first)
+import Control.Category (Category, (.))
import Data.Binary (Binary)
import Data.Typeable (Typeable)
@@ -33,85 +24,16 @@ import Hakyll.Core.Identifier.Pattern
import Hakyll.Core.CompiledItem
import Hakyll.Core.Writable
import Hakyll.Core.ResourceProvider
-
--- | A set of dependencies
---
-type Dependencies = Set Identifier
-
--- | A lookup with which we can get dependencies
---
-type DependencyLookup = Identifier -> CompiledItem
-
--- | Environment in which a compiler runs
---
-data CompilerEnvironment = CompilerEnvironment
- { compilerIdentifier :: Identifier -- ^ Target identifier
- , compilerResourceProvider :: ResourceProvider -- ^ Resource provider
- , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup
- }
-
--- | The compiler monad
---
-newtype CompilerM a = CompilerM
- { unCompilerM :: ReaderT CompilerEnvironment IO a
- } deriving (Monad, Functor, Applicative)
-
--- | The compiler arrow
---
-data Compiler a b = Compiler
- { compilerDependencies :: Reader ResourceProvider Dependencies
- , compilerJob :: a -> CompilerM b
- }
-
-instance Category Compiler where
- id = Compiler (return S.empty) return
- (Compiler d1 j1) . (Compiler d2 j2) =
- Compiler (liftM2 S.union d1 d2) (j1 <=< j2)
-
-instance Arrow Compiler where
- arr f = Compiler (return S.empty) (return . f)
- first (Compiler d j) = Compiler d $ \(x, y) -> do
- x' <- j x
- return (x', y)
-
--- | Run a compiler, yielding the resulting target and it's dependencies
---
-runCompiler :: Compiler () a
- -> Identifier
- -> ResourceProvider
- -> DependencyLookup
- -> IO a
-runCompiler compiler identifier provider lookup' =
- runReaderT (unCompilerM $ compilerJob compiler ()) env
- where
- env = CompilerEnvironment
- { compilerIdentifier = identifier
- , compilerResourceProvider = provider
- , compilerDependencyLookup = lookup'
- }
-
-getDependencies :: Compiler () a
- -> ResourceProvider
- -> Dependencies
-getDependencies compiler provider =
- runReader (compilerDependencies compiler) provider
-
-addDependencies :: (ResourceProvider -> [Identifier])
- -> Compiler b b
-addDependencies deps = Compiler (S.fromList . deps <$> ask) return
-
-fromCompilerM :: (a -> CompilerM b)
- -> Compiler a b
-fromCompilerM = Compiler (return S.empty)
+import Hakyll.Core.Compiler.Internal
getIdentifier :: Compiler a Identifier
-getIdentifier = fromCompilerM $ const $ CompilerM $
+getIdentifier = fromJob $ const $ CompilerM $
compilerIdentifier <$> ask
getResourceString :: Compiler a String
getResourceString = getIdentifier >>> getResourceString'
where
- getResourceString' = fromCompilerM $ \id' -> CompilerM $ do
+ getResourceString' = fromJob $ \id' -> CompilerM $ do
provider <- compilerResourceProvider <$> ask
liftIO $ resourceString provider id'
@@ -123,7 +45,7 @@ require :: (Binary a, Typeable a, Writable a)
-> (b -> a -> c)
-> Compiler b c
require identifier f =
- addDependencies (const [identifier]) >>> fromCompilerM require'
+ fromDependencies (const [identifier]) >>> fromJob require'
where
require' x = CompilerM $ do
lookup' <- compilerDependencyLookup <$> ask
@@ -137,7 +59,7 @@ requireAll :: (Binary a, Typeable a, Writable a)
-> (b -> [a] -> c)
-> Compiler b c
requireAll pattern f =
- addDependencies getDeps >>> fromCompilerM requireAll'
+ fromDependencies getDeps >>> fromJob requireAll'
where
getDeps = matches pattern . resourceList
requireAll' x = CompilerM $ do