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, runStateT, 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.Resource
import Hakyll.Core.Resource.Provider
import Hakyll.Core.Resource.Provider.File
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 :: 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
reader = unRuntime $ addNewCompilers [] compilers
stateT = runReaderT reader $ env logger ruleSet provider store
((), state') <- runStateT stateT state
storeSet store "Hakyll.Core.Run.run" "dependencies" $ hakyllGraph state'
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)
modified :: ResourceProvider
-> Store
-> [Identifier]
-> IO (Set Identifier)
modified provider store ids = fmap S.fromList $ flip filterM ids $ \id' ->
resourceModified provider (Resource id') store
addNewCompilers :: [(Identifier, Compiler () CompileRule)]
-> [(Identifier, Compiler () CompileRule)]
-> Runtime ()
addNewCompilers oldCompilers newCompilers = Runtime $ do
logger <- hakyllLogger <$> ask
section logger "Adding new compilers"
provider <- hakyllResourceProvider <$> ask
store <- hakyllStore <$> ask
let
compilers = oldCompilers ++ newCompilers
dependencies = flip map compilers $ \(id', compiler) ->
let deps = runCompilerDependencies compiler id' provider
in (id', deps)
compilerMap = M.fromList compilers
currentGraph = fromList dependencies
completeGraph <- timed logger "Creating graph" $
mappend currentGraph . hakyllGraph <$> get
orderedCompilers <- timed logger "Solving dependencies" $ do
oldModified <- hakyllModified <$> get
newModified <- liftIO $ modified provider store $ map fst newCompilers
let modified' = oldModified `S.union` newModified
obsolete = S.filter (`member` currentGraph)
$ reachableNodes modified' $ reverse completeGraph
ordered = filter (`S.member` obsolete) $ solveDependencies currentGraph
modify $ updateState modified' completeGraph
return $ map (id &&& (compilerMap M.!)) ordered
unRuntime $ runCompilers orderedCompilers
where
updateState modified' graph state = state
{ hakyllModified = modified'
, hakyllGraph = graph
}
runCompilers :: [(Identifier, Compiler () CompileRule)]
-> Runtime ()
runCompilers [] = return ()
runCompilers ((id', compiler) : compilers) = Runtime $ do
logger <- hakyllLogger <$> ask
routes <- hakyllRoutes <$> ask
provider <- hakyllResourceProvider <$> ask
store <- hakyllStore <$> ask
modified' <- hakyllModified <$> get
section logger $ "Compiling " ++ show id'
let
isModified = id' `S.member` modified'
result <- timed logger "Total compile time" $ liftIO $
runCompiler compiler id' provider routes store isModified logger
case result of
Right (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
unRuntime $ runCompilers compilers
Right (MetaCompileRule newCompilers) ->
unRuntime $ addNewCompilers compilers newCompilers
Left err -> do
thrown logger err
unRuntime $ runCompilers compilers