summaryrefslogtreecommitdiff
path: root/src/Hakyll/Core/Run.hs
blob: e2ff9f306c47951877b12f71850356e261a145ff (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
-- | This is the module which binds it all together
--
module Hakyll.Core.Run where

import Control.Arrow ((&&&))
import Control.Monad (foldM, forM_)
import qualified Data.Map as M
import Data.Monoid (mempty)
import Data.Typeable (Typeable)
import Data.Binary (Binary)

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.DirectedGraph
import Hakyll.Core.DirectedGraph.DependencySolver
import Hakyll.Core.Writable
import Hakyll.Core.Store
import Hakyll.Core.CompiledItem

hakyll :: Rules -> IO ()
hakyll rules = do
    store <- makeStore "_store"
    provider <- fileResourceProvider
    hakyllWith rules provider store

hakyllWith :: Rules -> ResourceProvider -> Store -> IO ()
hakyllWith rules provider store = 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

        -- Fetch the routes
        route' = rulesRoute ruleSet

    -- Generate all the targets in order
    _ <- foldM (addTarget route') M.empty orderedTargets

    putStrLn "DONE."
  where
    addTarget route' map' (id', targ) = do
        compiled <- runTarget targ id' (dependencyLookup map') provider store
        putStrLn $ "Generated target: " ++ show id'

        case runRoute route' id' of
            Nothing -> return ()
            Just r  -> do
                putStrLn $ "Routing " ++ show id' ++ " to " ++ r
                write r compiled

        return $ M.insert id' compiled map'

    dependencyLookup map' id' = case M.lookup id' map' of
        Nothing -> error $ "dependencyLookup: " ++ show id' ++ " not found"
        Just d  -> d