diff options
Diffstat (limited to 'src/Hakyll/Core/Compiler.hs')
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 98 |
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 |