1 files changed, 207 insertions, 0 deletions
diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
new file mode 100644
index 0000000..09864be
--- /dev/null
+++ b/src/Hakyll/Core/Run.hs
@@ -0,0 +1,207 @@
+-- | This is the module which binds it all together
+--
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+module Hakyll.Core.Run
+    ( run
+    ) where
+
+import Prelude hiding (reverse)
+import Control.Monad (filterM)
+import Control.Monad.Trans (liftIO)
+import Control.Applicative (Applicative, (<$>))
+import Control.Monad.Reader (ReaderT, runReaderT, ask)
+import Control.Monad.State.Strict (StateT, evalStateT, get, modify)
+import Control.Arrow ((&&&))
+import qualified Data.Map as M
+import Data.Monoid (mempty, mappend)
+import System.FilePath ((</>))
+import Data.Set (Set)
+import qualified Data.Set as S
+
+import Hakyll.Core.Routes
+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.Internal
+import Hakyll.Core.DirectedGraph
+import Hakyll.Core.DirectedGraph.DependencySolver
+import Hakyll.Core.Writable
+import Hakyll.Core.Store
+import Hakyll.Core.Configuration
+import Hakyll.Core.Logger
+
+-- | Run all rules needed, return the rule set used
+--
+run :: HakyllConfiguration -> Rules -> IO RuleSet
+run configuration rules = do
+    logger <- makeLogger
+
+    section logger "Initialising"
+    store <- timed logger "Creating store" $
+        makeStore $ storeDirectory configuration
+    provider <- timed logger "Creating provider" $
+        fileResourceProvider configuration
+
+    let ruleSet = runRules rules provider
+        compilers = rulesCompilers ruleSet
+
+        -- Extract the reader/state
+        reader = unRuntime $ addNewCompilers [] compilers
+        state' = runReaderT reader $ env logger ruleSet provider store
+
+    evalStateT state' state
+
+    -- Flush and return
+    flushLogger logger
+    return ruleSet
+  where
+    env logger ruleSet provider store = RuntimeEnvironment
+        { hakyllLogger           = logger
+        , hakyllConfiguration    = configuration
+        , hakyllRoutes           = rulesRoutes ruleSet
+        , hakyllResourceProvider = provider
+        , hakyllStore            = store
+        }
+
+    state = RuntimeState
+        { hakyllModified = S.empty
+        , hakyllGraph    = mempty
+        }
+
+data RuntimeEnvironment = RuntimeEnvironment
+    { hakyllLogger           :: Logger
+    , hakyllConfiguration    :: HakyllConfiguration
+    , hakyllRoutes           :: Routes
+    , hakyllResourceProvider :: ResourceProvider
+    , hakyllStore            :: Store
+    }
+
+data RuntimeState = RuntimeState
+    { hakyllModified :: Set Identifier
+    , hakyllGraph    :: DirectedGraph Identifier
+    }
+
+newtype Runtime a = Runtime
+    { unRuntime :: ReaderT RuntimeEnvironment (StateT RuntimeState IO) a
+    } deriving (Functor, Applicative, Monad)
+
+-- | Return a set of modified identifiers
+--
+modified :: ResourceProvider     -- ^ Resource provider
+         -> Store                -- ^ Store
+         -> [Identifier]         -- ^ Identifiers to check
+         -> IO (Set Identifier)  -- ^ Modified resources
+modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
+    if resourceExists provider id'
+        then resourceModified provider (Resource id') store
+        else return False
+
+-- | Add a number of compilers and continue using these compilers
+--
+addNewCompilers :: [(Identifier, Compiler () CompileRule)]
+                -- ^ Remaining compilers yet to be run
+                -> [(Identifier, Compiler () CompileRule)]
+                -- ^ Compilers to add
+                -> Runtime ()
+addNewCompilers oldCompilers newCompilers = Runtime $ do
+    -- Get some information
+    logger <- hakyllLogger <$> ask
+    section logger "Adding new compilers"
+    provider <- hakyllResourceProvider <$> ask
+    store <- hakyllStore <$> ask
+
+    let -- All compilers
+        compilers = oldCompilers ++ newCompilers
+
+        -- Get all dependencies for the compilers
+        dependencies = flip map compilers $ \(id', compiler) ->
+            let deps = runCompilerDependencies compiler id' provider
+            in (id', deps)
+
+        -- Create a compiler map (Id -> Compiler)
+        compilerMap = M.fromList compilers
+
+        -- Create the dependency graph
+        currentGraph = fromList dependencies
+
+    -- Find the old graph and append the new graph to it. This forms the
+    -- complete graph
+    completeGraph <- timed logger "Creating graph" $
+        mappend currentGraph . hakyllGraph <$> get
+
+    orderedCompilers <- timed logger "Solving dependencies" $ do
+        -- Check which items are up-to-date. This only needs to happen for the new
+        -- compilers
+        oldModified <- hakyllModified <$> get 
+        newModified <- liftIO $ modified provider store $ map fst newCompilers
+
+        let modified' = oldModified `S.union` newModified
+            
+            -- Find obsolete items. Every item that is reachable from a modified
+            -- item is considered obsolete. From these obsolete items, we are only
+            -- interested in ones that are in the current subgraph.
+            obsolete = S.filter (`member` currentGraph)
+                     $ reachableNodes modified' $ reverse completeGraph
+
+            -- Solve the graph and retain only the obsolete items
+            ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph
+
+        -- Update the state
+        modify $ updateState modified' completeGraph
+
+        -- Join the order with the compilers again
+        return $ map (id &&& (compilerMap M.!)) ordered
+
+    -- Now run the ordered list of compilers
+    unRuntime $ runCompilers orderedCompilers
+  where
+    -- Add the modified information for the new compilers
+    updateState modified' graph state = state
+        { hakyllModified = modified'
+        , hakyllGraph    = graph
+        }
+
+runCompilers :: [(Identifier, Compiler () CompileRule)]
+             -- ^ Ordered list of compilers
+             -> Runtime ()
+             -- ^ No result
+runCompilers [] = return ()
+runCompilers ((id', compiler) : compilers) = Runtime $ do
+    -- Obtain information
+    logger <- hakyllLogger <$> ask
+    routes <- hakyllRoutes <$> ask
+    provider <- hakyllResourceProvider <$> ask
+    store <- hakyllStore <$> ask
+    modified' <- hakyllModified <$> get
+
+    section logger $ "Compiling " ++ show id'
+
+    let -- Check if the resource was modified
+        isModified = id' `S.member` modified'
+
+    -- Run the compiler
+    result <- timed logger "Total compile time" $ liftIO $
+        runCompiler compiler id' provider routes store isModified logger
+
+    case result of
+        -- Compile rule for one item, easy stuff
+        CompileRule compiled -> do
+            case runRoutes routes id' of
+                Nothing  -> return ()
+                Just url -> timed logger ("Routing to " ++ url) $ do
+                    destination <-
+                        destinationDirectory . hakyllConfiguration <$> ask
+                    let path = destination </> url
+                    liftIO $ makeDirectories path
+                    liftIO $ write path compiled
+
+            -- Continue for the remaining compilers
+            unRuntime $ runCompilers compilers 
+
+        -- Metacompiler, slightly more complicated
+        MetaCompileRule newCompilers ->
+            -- Actually I was just kidding, it's not hard at all
+            unRuntime $ addNewCompilers compilers newCompilers