--------------------------------------------------------------------------------
module Hakyll.Core.Runtime
    ( run
    ) where


--------------------------------------------------------------------------------
import           Control.Monad                 (unless)
import           Control.Monad.Except          (ExceptT, runExceptT, throwError)
import           Control.Monad.Reader          (ask)
import           Control.Monad.RWS             (RWST, runRWST)
import           Control.Monad.State           (get, modify)
import           Control.Monad.Trans           (liftIO)
import           Data.List                     (intercalate)
import           Data.Map                      (Map)
import qualified Data.Map                      as M
import           Data.Set                      (Set)
import qualified Data.Set                      as S
import           System.Exit                   (ExitCode (..))
import           System.FilePath               ((</>))


--------------------------------------------------------------------------------
import           Hakyll.Core.Compiler.Internal
import           Hakyll.Core.Compiler.Require
import           Hakyll.Core.Configuration
import           Hakyll.Core.Dependencies
import           Hakyll.Core.Identifier
import           Hakyll.Core.Item
import           Hakyll.Core.Item.SomeItem
import           Hakyll.Core.Logger            (Logger)
import qualified Hakyll.Core.Logger            as Logger
import           Hakyll.Core.Provider
import           Hakyll.Core.Routes
import           Hakyll.Core.Rules.Internal
import           Hakyll.Core.Store             (Store)
import qualified Hakyll.Core.Store             as Store
import           Hakyll.Core.Util.File
import           Hakyll.Core.Writable


--------------------------------------------------------------------------------
run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run :: Configuration -> Logger -> Rules a -> IO (ExitCode, RuleSet)
run Configuration
config Logger
logger Rules a
rules = do
    -- Initialization
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Initialising..."
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger String
"Creating store..."
    Store
store <- Bool -> String -> IO Store
Store.new (Configuration -> Bool
inMemoryCache Configuration
config) (String -> IO Store) -> String -> IO Store
forall a b. (a -> b) -> a -> b
$ Configuration -> String
storeDirectory Configuration
config
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger String
"Creating provider..."
    Provider
provider <- Store -> (String -> IO Bool) -> String -> IO Provider
newProvider Store
store (Configuration -> String -> IO Bool
shouldIgnoreFile Configuration
config) (String -> IO Provider) -> String -> IO Provider
forall a b. (a -> b) -> a -> b
$
        Configuration -> String
providerDirectory Configuration
config
    Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger String
"Running rules..."
    RuleSet
ruleSet  <- Rules a -> Provider -> IO RuleSet
forall a. Rules a -> Provider -> IO RuleSet
runRules Rules a
rules Provider
provider

    -- Get old facts
    Result DependencyFacts
mOldFacts <- Store -> [String] -> IO (Result DependencyFacts)
forall a.
(Binary a, Typeable a) =>
Store -> [String] -> IO (Result a)
Store.get Store
store [String]
factsKey
    let (DependencyFacts
oldFacts) = case Result DependencyFacts
mOldFacts of Store.Found DependencyFacts
f -> DependencyFacts
f
                                       Result DependencyFacts
_             -> DependencyFacts
forall a. Monoid a => a
mempty

    -- Build runtime read/state
    let compilers :: [(Identifier, Compiler SomeItem)]
compilers = RuleSet -> [(Identifier, Compiler SomeItem)]
rulesCompilers RuleSet
ruleSet
        read' :: RuntimeRead
read'     = RuntimeRead :: Configuration
-> Logger
-> Provider
-> Store
-> Routes
-> Map Identifier (Compiler SomeItem)
-> RuntimeRead
RuntimeRead
            { runtimeConfiguration :: Configuration
runtimeConfiguration = Configuration
config
            , runtimeLogger :: Logger
runtimeLogger        = Logger
logger
            , runtimeProvider :: Provider
runtimeProvider      = Provider
provider
            , runtimeStore :: Store
runtimeStore         = Store
store
            , runtimeRoutes :: Routes
runtimeRoutes        = RuleSet -> Routes
rulesRoutes RuleSet
ruleSet
            , runtimeUniverse :: Map Identifier (Compiler SomeItem)
runtimeUniverse      = [(Identifier, Compiler SomeItem)]
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Identifier, Compiler SomeItem)]
compilers
            }
        state :: RuntimeState
state     = RuntimeState :: Set Identifier
-> Set (Identifier, String)
-> Map Identifier (Compiler SomeItem)
-> DependencyFacts
-> RuntimeState
RuntimeState
            { runtimeDone :: Set Identifier
runtimeDone      = Set Identifier
forall a. Set a
S.empty
            , runtimeSnapshots :: Set (Identifier, String)
runtimeSnapshots = Set (Identifier, String)
forall a. Set a
S.empty
            , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo      = Map Identifier (Compiler SomeItem)
forall k a. Map k a
M.empty
            , runtimeFacts :: DependencyFacts
runtimeFacts     = DependencyFacts
oldFacts
            }

    -- Run the program and fetch the resulting state
    Either String ((), RuntimeState, ())
result <- ExceptT String IO ((), RuntimeState, ())
-> IO (Either String ((), RuntimeState, ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT String IO ((), RuntimeState, ())
 -> IO (Either String ((), RuntimeState, ())))
-> ExceptT String IO ((), RuntimeState, ())
-> IO (Either String ((), RuntimeState, ()))
forall a b. (a -> b) -> a -> b
$ RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
-> RuntimeRead
-> RuntimeState
-> ExceptT String IO ((), RuntimeState, ())
forall r w s (m :: * -> *) a.
RWST r w s m a -> r -> s -> m (a, s, w)
runRWST RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
build RuntimeRead
read' RuntimeState
state
    case Either String ((), RuntimeState, ())
result of
        Left String
e          -> do
            Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.error Logger
logger String
e
            Logger -> IO ()
Logger.flush Logger
logger
            (ExitCode, RuleSet) -> IO (ExitCode, RuleSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1, RuleSet
ruleSet)

        Right (()
_, RuntimeState
s, ()
_) -> do
            Store -> [String] -> DependencyFacts -> IO ()
forall a. (Binary a, Typeable a) => Store -> [String] -> a -> IO ()
Store.set Store
store [String]
factsKey (DependencyFacts -> IO ()) -> DependencyFacts -> IO ()
forall a b. (a -> b) -> a -> b
$ RuntimeState -> DependencyFacts
runtimeFacts RuntimeState
s

            Logger -> String -> IO ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger String
"Removing tmp directory..."
            String -> IO ()
removeDirectory (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Configuration -> String
tmpDirectory Configuration
config

            Logger -> IO ()
Logger.flush Logger
logger
            (ExitCode, RuleSet) -> IO (ExitCode, RuleSet)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
ExitSuccess, RuleSet
ruleSet)
  where
    factsKey :: [String]
factsKey = [String
"Hakyll.Core.Runtime.run", String
"facts"]


--------------------------------------------------------------------------------
data RuntimeRead = RuntimeRead
    { RuntimeRead -> Configuration
runtimeConfiguration :: Configuration
    , RuntimeRead -> Logger
runtimeLogger        :: Logger
    , RuntimeRead -> Provider
runtimeProvider      :: Provider
    , RuntimeRead -> Store
runtimeStore         :: Store
    , RuntimeRead -> Routes
runtimeRoutes        :: Routes
    , RuntimeRead -> Map Identifier (Compiler SomeItem)
runtimeUniverse      :: Map Identifier (Compiler SomeItem)
    }


--------------------------------------------------------------------------------
data RuntimeState = RuntimeState
    { RuntimeState -> Set Identifier
runtimeDone      :: Set Identifier
    , RuntimeState -> Set (Identifier, String)
runtimeSnapshots :: Set (Identifier, Snapshot)
    , RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo      :: Map Identifier (Compiler SomeItem)
    , RuntimeState -> DependencyFacts
runtimeFacts     :: DependencyFacts
    }


--------------------------------------------------------------------------------
type Runtime a = RWST RuntimeRead () RuntimeState (ExceptT String IO) a


--------------------------------------------------------------------------------
build :: Runtime ()
build :: RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
build = do
    Logger
logger <- RuntimeRead -> Logger
runtimeLogger (RuntimeRead -> Logger)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Checking for out-of-date items"
    RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
scheduleOutOfDate
    Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Compiling"
    RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
pickAndChase
    Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.header Logger
logger String
"Success"


--------------------------------------------------------------------------------
scheduleOutOfDate :: Runtime ()
scheduleOutOfDate :: RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
scheduleOutOfDate = do
    Logger
logger   <- RuntimeRead -> Logger
runtimeLogger   (RuntimeRead -> Logger)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Provider
provider <- RuntimeRead -> Provider
runtimeProvider (RuntimeRead -> Provider)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    Map Identifier (Compiler SomeItem)
universe <- RuntimeRead -> Map Identifier (Compiler SomeItem)
runtimeUniverse (RuntimeRead -> Map Identifier (Compiler SomeItem))
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
    DependencyFacts
facts    <- RuntimeState -> DependencyFacts
runtimeFacts    (RuntimeState -> DependencyFacts)
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) DependencyFacts
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
forall s (m :: * -> *). MonadState s m => m s
get
    Map Identifier (Compiler SomeItem)
todo     <- RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo     (RuntimeState -> Map Identifier (Compiler SomeItem))
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
forall s (m :: * -> *). MonadState s m => m s
get

    let identifiers :: [Identifier]
identifiers = Map Identifier (Compiler SomeItem) -> [Identifier]
forall k a. Map k a -> [k]
M.keys Map Identifier (Compiler SomeItem)
universe
        modified :: Set Identifier
modified    = [Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList ([Identifier] -> Set Identifier) -> [Identifier] -> Set Identifier
forall a b. (a -> b) -> a -> b
$ ((Identifier -> Bool) -> [Identifier] -> [Identifier])
-> [Identifier] -> (Identifier -> Bool) -> [Identifier]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Identifier -> Bool) -> [Identifier] -> [Identifier]
forall a. (a -> Bool) -> [a] -> [a]
filter [Identifier]
identifiers ((Identifier -> Bool) -> [Identifier])
-> (Identifier -> Bool) -> [Identifier]
forall a b. (a -> b) -> a -> b
$
            Provider -> Identifier -> Bool
resourceModified Provider
provider

    let (Set Identifier
ood, DependencyFacts
facts', [String]
msgs) = [Identifier]
-> Set Identifier
-> DependencyFacts
-> (Set Identifier, DependencyFacts, [String])
outOfDate [Identifier]
identifiers Set Identifier
modified DependencyFacts
facts
        todo' :: Map Identifier (Compiler SomeItem)
todo'               = (Identifier -> Compiler SomeItem -> Bool)
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
M.filterWithKey
            (\Identifier
id' Compiler SomeItem
_ -> Identifier
id' Identifier -> Set Identifier -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Identifier
ood) Map Identifier (Compiler SomeItem)
universe

    -- Print messages
    (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> [String]
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger) [String]
msgs

    -- Update facts and todo items
    (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
        { runtimeDone :: Set Identifier
runtimeDone  = RuntimeState -> Set Identifier
runtimeDone RuntimeState
s Set Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => Set a -> Set a -> Set a
`S.union`
            ([Identifier] -> Set Identifier
forall a. Ord a => [a] -> Set a
S.fromList [Identifier]
identifiers Set Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => Set a -> Set a -> Set a
`S.difference` Set Identifier
ood)
        , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo  = Map Identifier (Compiler SomeItem)
todo Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => Map k a -> Map k a -> Map k a
`M.union` Map Identifier (Compiler SomeItem)
todo'
        , runtimeFacts :: DependencyFacts
runtimeFacts = DependencyFacts
facts'
        }


--------------------------------------------------------------------------------
pickAndChase :: Runtime ()
pickAndChase :: RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
pickAndChase = do
    Map Identifier (Compiler SomeItem)
todo <- RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo (RuntimeState -> Map Identifier (Compiler SomeItem))
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
forall s (m :: * -> *). MonadState s m => m s
get
    case Map Identifier (Compiler SomeItem)
-> Maybe
     ((Identifier, Compiler SomeItem),
      Map Identifier (Compiler SomeItem))
forall k a. Map k a -> Maybe ((k, a), Map k a)
M.minViewWithKey Map Identifier (Compiler SomeItem)
todo of
        Maybe
  ((Identifier, Compiler SomeItem),
   Map Identifier (Compiler SomeItem))
Nothing            -> () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just ((Identifier
id', Compiler SomeItem
_), Map Identifier (Compiler SomeItem)
_) -> do
            [Identifier]
-> Identifier
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
chase [] Identifier
id'
            RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
pickAndChase


--------------------------------------------------------------------------------
chase :: [Identifier] -> Identifier -> Runtime ()
chase :: [Identifier]
-> Identifier
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
chase [Identifier]
trail Identifier
id'
    | Identifier
id' Identifier -> [Identifier] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Identifier]
trail = String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Hakyll.Core.Runtime.chase: " String -> String -> String
forall a. [a] -> [a] -> [a]
++
        String
"Dependency cycle detected: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
" depends on "
            ((Identifier -> String) -> [Identifier] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Identifier -> String
forall a. Show a => a -> String
show ([Identifier] -> [String]) -> [Identifier] -> [String]
forall a b. (a -> b) -> a -> b
$ (Identifier -> Bool) -> [Identifier] -> [Identifier]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
/= Identifier
id') ([Identifier] -> [Identifier]
forall a. [a] -> [a]
reverse [Identifier]
trail) [Identifier] -> [Identifier] -> [Identifier]
forall a. [a] -> [a] -> [a]
++ [Identifier
id'])
    | Bool
otherwise        = do
        Logger
logger   <- RuntimeRead -> Logger
runtimeLogger        (RuntimeRead -> Logger)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
        Map Identifier (Compiler SomeItem)
todo     <- RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo          (RuntimeState -> Map Identifier (Compiler SomeItem))
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
forall s (m :: * -> *). MonadState s m => m s
get
        Provider
provider <- RuntimeRead -> Provider
runtimeProvider      (RuntimeRead -> Provider)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) Provider
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
        Map Identifier (Compiler SomeItem)
universe <- RuntimeRead -> Map Identifier (Compiler SomeItem)
runtimeUniverse      (RuntimeRead -> Map Identifier (Compiler SomeItem))
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Map Identifier (Compiler SomeItem))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
        Routes
routes   <- RuntimeRead -> Routes
runtimeRoutes        (RuntimeRead -> Routes)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) Routes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
        Store
store    <- RuntimeRead -> Store
runtimeStore         (RuntimeRead -> Store)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) Store
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
        Configuration
config   <- RuntimeRead -> Configuration
runtimeConfiguration (RuntimeRead -> Configuration)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) Configuration
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeRead
forall r (m :: * -> *). MonadReader r m => m r
ask
        Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Processing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id'

        let compiler :: Compiler SomeItem
compiler = Map Identifier (Compiler SomeItem)
todo Map Identifier (Compiler SomeItem)
-> Identifier -> Compiler SomeItem
forall k a. Ord k => Map k a -> k -> a
M.! Identifier
id'
            read' :: CompilerRead
read' = CompilerRead :: Configuration
-> Identifier
-> Provider
-> Set Identifier
-> Routes
-> Store
-> Logger
-> CompilerRead
CompilerRead
                { compilerConfig :: Configuration
compilerConfig     = Configuration
config
                , compilerUnderlying :: Identifier
compilerUnderlying = Identifier
id'
                , compilerProvider :: Provider
compilerProvider   = Provider
provider
                , compilerUniverse :: Set Identifier
compilerUniverse   = Map Identifier (Compiler SomeItem) -> Set Identifier
forall k a. Map k a -> Set k
M.keysSet Map Identifier (Compiler SomeItem)
universe
                , compilerRoutes :: Routes
compilerRoutes     = Routes
routes
                , compilerStore :: Store
compilerStore      = Store
store
                , compilerLogger :: Logger
compilerLogger     = Logger
logger
                }

        CompilerResult SomeItem
result <- IO (CompilerResult SomeItem)
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (CompilerResult SomeItem)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (CompilerResult SomeItem)
 -> RWST
      RuntimeRead
      ()
      RuntimeState
      (ExceptT String IO)
      (CompilerResult SomeItem))
-> IO (CompilerResult SomeItem)
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (CompilerResult SomeItem)
forall a b. (a -> b) -> a -> b
$ Compiler SomeItem -> CompilerRead -> IO (CompilerResult SomeItem)
forall a. Compiler a -> CompilerRead -> IO (CompilerResult a)
runCompiler Compiler SomeItem
compiler CompilerRead
read'
        case CompilerResult SomeItem
result of
            -- Rethrow error
            CompilerError CompilerErrors String
e -> String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ case CompilerErrors String -> [String]
forall a. CompilerErrors a -> [a]
compilerErrorMessages CompilerErrors String
e of
                [] -> String
"Compiler failed but no info given, try running with -v?"
                [String]
es -> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; " [String]
es

            -- Signal that a snapshot was saved ->
            CompilerSnapshot String
snapshot Compiler SomeItem
c -> do
                -- Update info. The next 'chase' will pick us again at some
                -- point so we can continue then.
                (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
                    { runtimeSnapshots :: Set (Identifier, String)
runtimeSnapshots =
                        (Identifier, String)
-> Set (Identifier, String) -> Set (Identifier, String)
forall a. Ord a => a -> Set a -> Set a
S.insert (Identifier
id', String
snapshot) (RuntimeState -> Set (Identifier, String)
runtimeSnapshots RuntimeState
s)
                    , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo      = Identifier
-> Compiler SomeItem
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
id' Compiler SomeItem
c (RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
s)
                    }

            -- Huge success
            CompilerDone (SomeItem Item a
item) CompilerWrite
cwrite -> do
                -- Print some info
                let facts :: [Dependency]
facts = CompilerWrite -> [Dependency]
compilerDependencies CompilerWrite
cwrite
                    cacheHits :: String
cacheHits
                        | CompilerWrite -> Int
compilerCacheHits CompilerWrite
cwrite Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = String
"updated"
                        | Bool
otherwise                     = String
"cached "
                Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.message Logger
logger (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
cacheHits String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id'

                -- Sanity check
                Bool
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item Identifier -> Identifier -> Bool
forall a. Eq a => a -> a -> Bool
== Identifier
id') (RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
 -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$
                    String
"The compiler yielded an Item with Identifier " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    Identifier -> String
forall a. Show a => a -> String
show (Item a -> Identifier
forall a. Item a -> Identifier
itemIdentifier Item a
item) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", but we were expecting " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
"an Item with Identifier " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
id' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
"(you probably want to call makeItem to solve this problem)"

                -- Write if necessary
                (Maybe String
mroute, Bool
_) <- IO (Maybe String, Bool)
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Maybe String, Bool)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String, Bool)
 -> RWST
      RuntimeRead
      ()
      RuntimeState
      (ExceptT String IO)
      (Maybe String, Bool))
-> IO (Maybe String, Bool)
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Maybe String, Bool)
forall a b. (a -> b) -> a -> b
$ Routes -> Provider -> Identifier -> IO (Maybe String, Bool)
runRoutes Routes
routes Provider
provider Identifier
id'
                case Maybe String
mroute of
                    Maybe String
Nothing    -> () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    Just String
route -> do
                        let path :: String
path = Configuration -> String
destinationDirectory Configuration
config String -> String -> String
</> String
route
                        IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
makeDirectories String
path
                        IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String -> Item a -> IO ()
forall a. Writable a => String -> Item a -> IO ()
write String
path Item a
item
                        Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Routed to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
path

                -- Save! (For load)
                IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> IO () -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ Store -> Item a -> IO ()
forall a. (Binary a, Typeable a) => Store -> Item a -> IO ()
save Store
store Item a
item

                -- Update state
                (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
                    { runtimeDone :: Set Identifier
runtimeDone  = Identifier -> Set Identifier -> Set Identifier
forall a. Ord a => a -> Set a -> Set a
S.insert Identifier
id' (RuntimeState -> Set Identifier
runtimeDone RuntimeState
s)
                    , runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo  = Identifier
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Identifier
id' (RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
s)
                    , runtimeFacts :: DependencyFacts
runtimeFacts = Identifier -> [Dependency] -> DependencyFacts -> DependencyFacts
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
id' [Dependency]
facts (RuntimeState -> DependencyFacts
runtimeFacts RuntimeState
s)
                    }

            -- Try something else first
            CompilerRequire (Identifier, String)
dep Compiler SomeItem
c -> do
                -- Update the compiler so we don't execute it twice
                let (Identifier
depId, String
depSnapshot) = (Identifier, String)
dep
                Set Identifier
done      <- RuntimeState -> Set Identifier
runtimeDone (RuntimeState -> Set Identifier)
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) (Set Identifier)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
forall s (m :: * -> *). MonadState s m => m s
get
                Set (Identifier, String)
snapshots <- RuntimeState -> Set (Identifier, String)
runtimeSnapshots (RuntimeState -> Set (Identifier, String))
-> RWST
     RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
-> RWST
     RuntimeRead
     ()
     RuntimeState
     (ExceptT String IO)
     (Set (Identifier, String))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RWST RuntimeRead () RuntimeState (ExceptT String IO) RuntimeState
forall s (m :: * -> *). MonadState s m => m s
get

                -- Done if we either completed the entire item (runtimeDone) or
                -- if we previously saved the snapshot (runtimeSnapshots).
                let depDone :: Bool
depDone =
                        Identifier
depId Identifier -> Set Identifier -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Identifier
done Bool -> Bool -> Bool
||
                        (Identifier
depId, String
depSnapshot) (Identifier, String) -> Set (Identifier, String) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set (Identifier, String)
snapshots

                (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RuntimeState -> RuntimeState)
 -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> (RuntimeState -> RuntimeState)
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ \RuntimeState
s -> RuntimeState
s
                    { runtimeTodo :: Map Identifier (Compiler SomeItem)
runtimeTodo = Identifier
-> Compiler SomeItem
-> Map Identifier (Compiler SomeItem)
-> Map Identifier (Compiler SomeItem)
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Identifier
id'
                        (if Bool
depDone then Compiler SomeItem
c else CompilerResult SomeItem -> Compiler SomeItem
forall a. CompilerResult a -> Compiler a
compilerResult CompilerResult SomeItem
result)
                        (RuntimeState -> Map Identifier (Compiler SomeItem)
runtimeTodo RuntimeState
s)
                    }

                -- If the required item is already compiled, continue, or, start
                -- chasing that
                Logger
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall (m :: * -> *). MonadIO m => Logger -> String -> m ()
Logger.debug Logger
logger (String -> RWST RuntimeRead () RuntimeState (ExceptT String IO) ())
-> String
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
forall a b. (a -> b) -> a -> b
$ String
"Require " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Identifier -> String
forall a. Show a => a -> String
show Identifier
depId String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    String
" (snapshot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
depSnapshot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"): " String -> String -> String
forall a. [a] -> [a] -> [a]
++
                    (if Bool
depDone then String
"OK" else String
"chasing")
                if Bool
depDone then [Identifier]
-> Identifier
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
chase [Identifier]
trail Identifier
id' else [Identifier]
-> Identifier
-> RWST RuntimeRead () RuntimeState (ExceptT String IO) ()
chase (Identifier
id' Identifier -> [Identifier] -> [Identifier]
forall a. a -> [a] -> [a]
: [Identifier]
trail) Identifier
depId