diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 98 | ||||
-rw-r--r-- | src/Hakyll/Core/Compiler/Internal.hs | 96 | ||||
-rw-r--r-- | src/Hakyll/Core/Run.hs | 5 |
3 files changed, 109 insertions, 90 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 diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs new file mode 100644 index 0000000..fd37343 --- /dev/null +++ b/src/Hakyll/Core/Compiler/Internal.hs @@ -0,0 +1,96 @@ +-- | Internally used compiler module +-- +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Hakyll.Core.Compiler.Internal + ( Dependencies + , CompilerEnvironment (..) + , CompilerM (..) + , Compiler (..) + , runCompilerJob + , runCompilerDependencies + , fromJob + , fromDependencies + ) where + +import Prelude hiding ((.), id) +import Control.Applicative (Applicative, (<$>)) +import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader) +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 Hakyll.Core.Identifier +import Hakyll.Core.CompiledItem +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 +-- +runCompilerJob :: Compiler () a + -> Identifier + -> ResourceProvider + -> DependencyLookup + -> IO a +runCompilerJob compiler identifier provider lookup' = + runReaderT (unCompilerM $ compilerJob compiler ()) env + where + env = CompilerEnvironment + { compilerIdentifier = identifier + , compilerResourceProvider = provider + , compilerDependencyLookup = lookup' + } + +runCompilerDependencies :: Compiler () a + -> ResourceProvider + -> Dependencies +runCompilerDependencies compiler provider = + runReader (compilerDependencies compiler) provider + +fromJob :: (a -> CompilerM b) + -> Compiler a b +fromJob = Compiler (return S.empty) + +fromDependencies :: (ResourceProvider -> [Identifier]) + -> Compiler b b +fromDependencies deps = Compiler (S.fromList . deps <$> ask) return diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs index 911e2f9..fa88458 100644 --- a/src/Hakyll/Core/Run.hs +++ b/src/Hakyll/Core/Run.hs @@ -14,6 +14,7 @@ import Hakyll.Core.Route import Hakyll.Core.Identifier import Hakyll.Core.Util.File import Hakyll.Core.Compiler +import Hakyll.Core.Compiler.Internal import Hakyll.Core.ResourceProvider import Hakyll.Core.ResourceProvider.FileResourceProvider import Hakyll.Core.Rules @@ -40,7 +41,7 @@ hakyllWith rules provider store = do -- Get all dependencies dependencies = flip map compilers $ \(id', compiler) -> - let deps = getDependencies compiler provider + let deps = runCompilerDependencies compiler provider in (id', deps) -- Create a compiler map @@ -65,7 +66,7 @@ hakyllWith rules provider store = do putStrLn "DONE." where addTarget route' map' (id', comp) = do - compiled <- runCompiler comp id' provider (dependencyLookup map') + compiled <- runCompilerJob comp id' provider (dependencyLookup map') putStrLn $ "Generated target: " ++ show id' case runRoute route' id' of |