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 :: 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
state' = runReaderT reader $ env logger ruleSet provider store
evalStateT state' 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' ->
if resourceExists provider id'
then resourceModified provider (Resource id') store
else return False
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