Compiler → {Compiler, Compiler.Internal}

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