From ec85de418b01b4eaefb286a52c050a141204d46f Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Sat, 25 Dec 2010 22:02:20 +0100
Subject: Prototype Run module

---
 src/Hakyll/Core/Run.hs             | 68 ++++++++++++++++++++++++++++++++++++++
 src/Hakyll/Core/Target.hs          | 14 ++++++++
 src/Hakyll/Core/Target/Internal.hs | 16 ++++++---
 3 files changed, 94 insertions(+), 4 deletions(-)
 create mode 100644 src/Hakyll/Core/Run.hs

(limited to 'src')

diff --git a/src/Hakyll/Core/Run.hs b/src/Hakyll/Core/Run.hs
new file mode 100644
index 0000000..4683768
--- /dev/null
+++ b/src/Hakyll/Core/Run.hs
@@ -0,0 +1,68 @@
+-- | This is the module which binds it all together
+--
+module Hakyll.Core.Run where
+
+import Control.Arrow ((&&&))
+import Control.Monad (msum, foldM, forM, forM_)
+import qualified Data.Map as M
+
+import Hakyll.Core.Route
+import Hakyll.Core.Compiler
+import Hakyll.Core.ResourceProvider
+import Hakyll.Core.ResourceProvider.FileResourceProvider
+import Hakyll.Core.Rules
+import Hakyll.Core.Target
+import Hakyll.Core.Identifier
+import Hakyll.Core.DirectedGraph
+import Hakyll.Core.DirectedGraph.DependencySolver
+import Hakyll.Core.Writable
+
+hakyll :: Writable a => Rules a -> IO ()
+hakyll rules = do
+    provider <- fileResourceProvider
+    hakyllWith rules provider
+
+hakyllWith :: Writable a => Rules a -> ResourceProvider -> IO ()
+hakyllWith rules provider = do
+    let -- Get the rule set
+        ruleSet = runRules rules provider
+
+        -- Get all identifiers and compilers
+        compilers = rulesCompilers ruleSet
+
+        -- Get all targets
+        targets = flip map compilers $ \(id', compiler) ->
+            let (targ, deps) = runCompiler compiler id'
+            in (id', targ, deps)
+
+        -- Map mapping every identifier to it's target
+        targetMap = M.fromList $ map (\(i, t, _) -> (i, t)) targets
+
+        -- Create a dependency graph
+        graph = fromList $ map (\(i, _, d) -> (i, d)) targets
+
+        -- Solve the graph, creating a target order
+        ordered = solveDependencies graph
+
+        -- Join the order with the targets again
+        orderedTargets = map (id &&& (targetMap M.!)) ordered
+
+    -- Generate all the targets in order
+    map' <- foldM addTarget M.empty orderedTargets
+
+    let -- Fetch the routes
+        route' = rulesRoute ruleSet
+
+    forM_ (M.toList map') $ \(id', result) ->
+        case runRoute route' id' of
+            Nothing -> return ()
+            Just r  -> do
+                putStrLn $ "Routing " ++ show id' ++ " to " ++ r
+                write r result
+
+    putStrLn "DONE."
+  where
+    addTarget map' (id', targ) = do
+        result <- runTarget targ id' (map' M.!) provider
+        putStrLn $ "Generated target: " ++ show id'
+        return $ M.insert id' result map'
diff --git a/src/Hakyll/Core/Target.hs b/src/Hakyll/Core/Target.hs
index 1f783df..215a53b 100644
--- a/src/Hakyll/Core/Target.hs
+++ b/src/Hakyll/Core/Target.hs
@@ -6,6 +6,20 @@ module Hakyll.Core.Target
     , TargetM
     , Target
     , runTarget
+    , getResourceString
     ) where
 
+import Control.Applicative ((<$>))
+import Control.Monad.Reader (ask)
+import Control.Monad.Trans (liftIO)
+
 import Hakyll.Core.Target.Internal
+import Hakyll.Core.ResourceProvider
+
+-- | Get the resource content as a string
+--
+getResourceString :: TargetM a String
+getResourceString = TargetM $ do
+    provider <- targetResourceProvider <$> ask
+    identifier <- targetIdentifier <$> ask
+    liftIO $ resourceString provider identifier
diff --git a/src/Hakyll/Core/Target/Internal.hs b/src/Hakyll/Core/Target/Internal.hs
index 96e3087..f40c798 100644
--- a/src/Hakyll/Core/Target/Internal.hs
+++ b/src/Hakyll/Core/Target/Internal.hs
@@ -9,10 +9,12 @@ module Hakyll.Core.Target.Internal
     , runTarget
     ) where
 
+import Control.Applicative (Applicative)
 import Control.Monad.Trans (MonadIO)
 import Control.Monad.Reader (ReaderT, runReaderT)
 
 import Hakyll.Core.Identifier
+import Hakyll.Core.ResourceProvider
 
 -- | A lookup with which we can get dependencies
 --
@@ -21,15 +23,16 @@ type DependencyLookup a = Identifier -> a
 -- | Environment for the target monad
 --
 data TargetEnvironment a = TargetEnvironment
-    { targetIdentifier       :: Identifier
+    { targetIdentifier       :: Identifier          -- ^ Identifier
     , targetDependencyLookup :: DependencyLookup a  -- ^ Dependency lookup
+    , targetResourceProvider :: ResourceProvider    -- ^ To get resources
     }
 
 -- | Monad for targets. In this monad, the user can compose targets and describe
 -- how they should be created.
 --
 newtype TargetM a b = TargetM {unTargetM :: ReaderT (TargetEnvironment a) IO b}
-                    deriving (Monad, Functor, MonadIO)
+                    deriving (Monad, Functor, Applicative, MonadIO)
 
 -- | Simplification of the 'TargetM' type for concrete cases: the type of the
 -- returned item should equal the type of the dependencies.
@@ -38,10 +41,15 @@ type Target a = TargetM a a
 
 -- | Run a target, yielding an actual result.
 --
-runTarget :: Target a -> Identifier -> DependencyLookup a -> IO a
-runTarget target id' lookup' = runReaderT (unTargetM target) env
+runTarget :: Target a
+          -> Identifier
+          -> DependencyLookup a
+          -> ResourceProvider
+          -> IO a
+runTarget target id' lookup' provider = runReaderT (unTargetM target) env
   where
     env = TargetEnvironment
         { targetIdentifier       = id'
         , targetDependencyLookup = lookup'
+        , targetResourceProvider = provider
         }
-- 
cgit v1.2.3