diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-25 22:02:20 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-25 22:02:20 +0100 |
commit | ec85de418b01b4eaefb286a52c050a141204d46f (patch) | |
tree | 09920771d52169533b477b17903a784c000ee5b6 /src/Hakyll | |
parent | 0cd7716dae87d50e79883152edf735132ae4798e (diff) | |
download | hakyll-ec85de418b01b4eaefb286a52c050a141204d46f.tar.gz |
Prototype Run module
Diffstat (limited to 'src/Hakyll')
-rw-r--r-- | src/Hakyll/Core/Run.hs | 68 | ||||
-rw-r--r-- | src/Hakyll/Core/Target.hs | 14 | ||||
-rw-r--r-- | src/Hakyll/Core/Target/Internal.hs | 16 |
3 files changed, 94 insertions, 4 deletions
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 } |