module Hakyll.Core.Run
( run
) where
import Prelude hiding (reverse)
import Control.Monad (filterM, forM_)
import Control.Monad.Trans (liftIO)
import Control.Applicative (Applicative, (<$>))
import Control.Monad.Reader (ReaderT, runReaderT, ask)
import Control.Monad.State.Strict (StateT, runStateT, get, put)
import Data.Map (Map)
import qualified Data.Map as M
import Data.Monoid (mempty, mappend)
import System.FilePath ((</>))
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.DependencyAnalyzer
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 putStrLn
section logger "Initialising"
store <- timed logger "Creating store" $
makeStore $ storeDirectory configuration
provider <- timed logger "Creating provider" $
fileResourceProvider configuration
graph <- storeGet store "Hakyll.Core.Run.run" "dependencies"
let (firstRun, oldGraph) = case graph of Found g -> (False, g)
_ -> (True, mempty)
let ruleSet = runRules rules provider
compilers = rulesCompilers ruleSet
reader = unRuntime $ addNewCompilers compilers
stateT = runReaderT reader $ RuntimeEnvironment
{ hakyllLogger = logger
, hakyllConfiguration = configuration
, hakyllRoutes = rulesRoutes ruleSet
, hakyllResourceProvider = provider
, hakyllStore = store
, hakyllFirstRun = firstRun
}
((), state') <- runStateT stateT $ RuntimeState
{ hakyllAnalyzer = makeDependencyAnalyzer mempty (const False) oldGraph
, hakyllCompilers = M.empty
}
storeSet store "Hakyll.Core.Run.run" "dependencies" $
analyzerGraph $ hakyllAnalyzer state'
flushLogger logger
return ruleSet
data RuntimeEnvironment = RuntimeEnvironment
{ hakyllLogger :: Logger
, hakyllConfiguration :: HakyllConfiguration
, hakyllRoutes :: Routes
, hakyllResourceProvider :: ResourceProvider
, hakyllStore :: Store
, hakyllFirstRun :: Bool
}
data RuntimeState = RuntimeState
{ hakyllAnalyzer :: DependencyAnalyzer Identifier
, hakyllCompilers :: Map Identifier (Compiler () CompileRule)
}
newtype Runtime a = Runtime
{ unRuntime :: ReaderT RuntimeEnvironment (StateT RuntimeState IO) a
} deriving (Functor, Applicative, Monad)
addNewCompilers :: [(Identifier, Compiler () CompileRule)]
-> Runtime ()
addNewCompilers newCompilers = Runtime $ do
logger <- hakyllLogger <$> ask
section logger "Adding new compilers"
provider <- hakyllResourceProvider <$> ask
store <- hakyllStore <$> ask
firstRun <- hakyllFirstRun <$> ask
oldCompilers <- hakyllCompilers <$> get
oldAnalyzer <- hakyllAnalyzer <$> get
let
universe = M.keys oldCompilers ++ map fst newCompilers
dependencies = flip map newCompilers $ \(id', compiler) ->
let deps = runCompilerDependencies compiler id' universe
in (id', deps)
newGraph = fromList dependencies
modified <- fmap S.fromList $ flip filterM (map fst newCompilers) $
liftIO . resourceModified provider store . fromIdentifier
let checkModified = if firstRun then const True else (`S.member` modified)
let newAnalyzer = makeDependencyAnalyzer newGraph checkModified $
analyzerPreviousGraph oldAnalyzer
analyzer = mappend oldAnalyzer newAnalyzer
put $ RuntimeState
{ hakyllAnalyzer = analyzer
, hakyllCompilers = M.union oldCompilers (M.fromList newCompilers)
}
unRuntime stepAnalyzer
stepAnalyzer :: Runtime ()
stepAnalyzer = Runtime $ do
state <- get
let (signal, analyzer') = step $ hakyllAnalyzer state
put $ state { hakyllAnalyzer = analyzer' }
case signal of Done -> return ()
Cycle c -> unRuntime $ dumpCycle c
Build id' -> unRuntime $ build id'
dumpCycle :: [Identifier] -> Runtime ()
dumpCycle cycle' = Runtime $ do
logger <- hakyllLogger <$> ask
section logger "Dependency cycle detected! Conflict:"
forM_ (zip cycle' $ drop 1 cycle') $ \(x, y) ->
report logger $ show x ++ " -> " ++ show y
build :: Identifier -> Runtime ()
build id' = Runtime $ do
logger <- hakyllLogger <$> ask
routes <- hakyllRoutes <$> ask
provider <- hakyllResourceProvider <$> ask
store <- hakyllStore <$> ask
compilers <- hakyllCompilers <$> get
section logger $ "Compiling " ++ show id'
let compiler = compilers M.! id'
isModified <- liftIO $ resourceModified provider store $ fromIdentifier id'
result <- timed logger "Total compile time" $ liftIO $
runCompiler compiler id' provider (M.keys compilers) 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 stepAnalyzer
Right (MetaCompileRule newCompilers) ->
unRuntime $ addNewCompilers newCompilers
Left err -> do
thrown logger err
unRuntime stepAnalyzer