module Laborantin (
prepare
, load
, remove
, runAnalyze
, missingParameterSets
, expandParameterSets
) where
import Laborantin.Types
import Laborantin.Query
import Laborantin.Implementation
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Error
import Control.Applicative
import qualified Data.Set as S
import qualified Data.Map as M
prepare :: (MonadIO m) => Backend m
-> TExpr Bool
-> [Execution m]
-> ScenarioDescription m
-> [m (Execution m)]
prepare b expr execs sc = map toAction neededParamSets
where toAction = execute b sc
neededParamSets = missingParameterSets sc expr existing
where existing = map eParamSet execs
missingParameterSets :: ScenarioDescription m -> TExpr Bool -> [ParameterSet] -> [ParameterSet]
missingParameterSets sc expr sets = listDiff target sets
where target = matchingParameterSets sc expr
matchingParameterSets :: ScenarioDescription m -> TExpr Bool -> [ParameterSet]
matchingParameterSets sc expr = filter matching allSets
where matching = matchTExpr' expr sc
allSets = expandParameterSets sc expr
expandParameterSets :: ScenarioDescription m -> TExpr Bool -> [ParameterSet]
expandParameterSets sc expr = paramSets $ expandParamSpace (sParams sc) expr
listDiff :: Ord a => [a] -> [a] -> [a]
listDiff l1 l2 = S.toList (S.fromList l1 `S.difference` S.fromList l2)
execute :: (MonadIO m) => Backend m -> ScenarioDescription m -> ParameterSet -> m (Execution m)
execute b sc prm = execution
where execution = do
(exec,final) <- bPrepareExecution b sc prm
status <- liftM fst $ runReaderT (runStateT (runErrorT (go exec `catchError` recover exec)) emptyEnv) (b, exec)
let exec' = either (\_ -> exec {eStatus = Failure}) (\_ -> exec {eStatus = Success}) status
bFinalizeExecution b exec' final
return exec'
where go exec = do
bSetup b exec
bRun b exec
bTeardown b exec
bAnalyze b exec
recover exec err = bRecover b err exec >> throwError err
load :: (MonadIO m) => Backend m -> [ScenarioDescription m] -> TExpr Bool -> m [Execution m]
load = bLoad
remove :: (MonadIO m) => Backend m -> Execution m -> m ()
remove = bRemove
runAnalyze :: (MonadIO m, Functor m) => Backend m -> Execution m -> m (Either AnalysisError ())
runAnalyze b exec = do
let status = runReaderT (runStateT (runErrorT (go exec)) emptyEnv) (b, exec)
(either rebrandError Right) . fst <$> status
where go exec = bAnalyze b exec
rebrandError (ExecutionError str) = Left $ AnalysisError str