{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}
{-# LANGUAGE TypeFamilies        #-}
{-# LANGUAGE ViewPatterns        #-}


module Experimenter.Eval.Ops
    ( genEvals
    , genEvalsIO
    , genEvalsConcurrent
    ) where

import           Conduit                      as C
import           Control.DeepSeq
import           Control.Lens                 hiding (Cons, Over)
import           Control.Monad.Reader
import qualified Data.Conduit.List            as CL
import           Data.List                    (find)
import           Data.Maybe                   (fromMaybe, isJust)
import qualified Data.Text                    as T
import qualified Data.Text.Encoding           as E
import qualified Database.Esqueleto           as E
import           Prelude                      hiding (exp)


import           Experimenter.Availability
import           Experimenter.ConcurrentIO
import           Experimenter.DatabaseSetting
import           Experimenter.DB
import           Experimenter.Eval.Reduce
import           Experimenter.Eval.Type       as E
import           Experimenter.Eval.Util
import           Experimenter.Experiment
import           Experimenter.Measure
import           Experimenter.Models
import           Experimenter.Result.Query
import           Experimenter.Result.Type
import           Experimenter.StepResult


genEvalsIO :: (ExperimentDef a, IO ~ ExpM a) => DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
genEvalsIO :: forall a.
(ExperimentDef a, IO ~ ExpM a) =>
DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
genEvalsIO = forall a.
ExperimentDef a =>
(ExpM a (Evals a) -> IO (Evals a))
-> DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
genEvals forall a. a -> a
id


genEvals :: (ExperimentDef a) => (ExpM a (Evals a) -> IO (Evals a)) -> DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
genEvals :: forall a.
ExperimentDef a =>
(ExpM a (Evals a) -> IO (Evals a))
-> DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
genEvals ExpM a (Evals a) -> IO (Evals a)
runExpM DatabaseSetting
dbSetup Experiments a
exps [StatsDef a]
evals = ExpM a (Evals a) -> IO (Evals a)
runExpM forall a b. (a -> b) -> a -> b
$ forall (m1 :: * -> *) a (m :: * -> *).
MonadUnliftIO m1 =>
(m1 a -> m a)
-> DatabaseSetting -> ReaderT SqlBackend (LoggingT m1) a -> m a
runDBWithM forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT DatabaseSetting
dbSetup forall a b. (a -> b) -> a -> b
$ do
  [ExperimentEval a]
res <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall a.
ExperimentDef a =>
[StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a)
mkEvals [StatsDef a]
evals) (Experiments a
exps forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiments a) [Experiment a]
experiments)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Experiments a -> [ExperimentEval a] -> Evals a
Evals (Experiments a
exps {_experiments :: [Experiment a]
_experiments = []}) [ExperimentEval a]
res


genEvalsConcurrent :: (ExperimentDef a) => Int -> (ExpM a (ExperimentEval a) -> IO (ExperimentEval a)) -> DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
genEvalsConcurrent :: forall a.
ExperimentDef a =>
Int
-> (ExpM a (ExperimentEval a) -> IO (ExperimentEval a))
-> DatabaseSetting
-> Experiments a
-> [StatsDef a]
-> IO (Evals a)
genEvalsConcurrent Int
parallelWorkers ExpM a (ExperimentEval a) -> IO (ExperimentEval a)
runExpM DatabaseSetting
dbSetup Experiments a
exps [StatsDef a]
evals = do
  [ExperimentEval a]
res <- forall b a. NFData b => Int -> (a -> IO b) -> [a] -> IO [b]
mapConurrentIO Int
parallelWorkers (ExpM a (ExperimentEval a) -> IO (ExperimentEval a)
runExpM forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m1 :: * -> *) a (m :: * -> *).
MonadUnliftIO m1 =>
(m1 a -> m a)
-> DatabaseSetting -> ReaderT SqlBackend (LoggingT m1) a -> m a
runDBWithM forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT DatabaseSetting
dbSetup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ExperimentDef a =>
[StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a)
mkEvals [StatsDef a]
evals) (Experiments a
exps forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiments a) [Experiment a]
experiments)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Experiments a -> [ExperimentEval a] -> Evals a
Evals (Experiments a
exps {_experiments :: [Experiment a]
_experiments = []}) [ExperimentEval a]
res

mkEvals :: (ExperimentDef a ) => [StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a)
mkEvals :: forall a.
ExperimentDef a =>
[StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a)
mkEvals [StatsDef a]
evals Experiment a
e = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
"Evaluating Experiment " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (Experiment a
e forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiment a) Int
experimentNumber)
  [Availability IO (EvalResults a)]
xs <- forall (m :: * -> *) t.
(MonadIO m, NFData t) =>
[Char] -> m t -> m t
mkTime [Char]
"All Experiment Evaluations" forall a b. (a -> b) -> a -> b
$ forall b (m :: * -> *) a.
(NFData b, Monad m) =>
(a -> m b) -> [a] -> m [b]
mapMRnf StatsDef a
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Availability IO (EvalResults a))
evalStatsDef [StatsDef a]
evals
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$ forall a.
Int
-> [Availability IO (EvalResults a)]
-> Experiment a
-> ExperimentEval a
ExperimentEval (Experiment a
e forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiment a) Int
experimentNumber) [Availability IO (EvalResults a)]
xs (Experiment a
e {_experimentResults :: [ExperimentResult a]
_experimentResults = []})
  where
    evalStatsDef :: StatsDef a
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Availability IO (EvalResults a))
evalStatsDef StatsDef a
statsDef = do
      -- liftIO $ putStrLn $ "Evaluating " ++ show statsDef
      forall (m :: * -> *) b. b -> Availability m b
Available forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
ExperimentDef a =>
Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
genExperiment Experiment a
e StatsDef a
statsDef

mapMRnf :: (NFData b, Monad m) => (a -> m b) -> [a] -> m [b]
mapMRnf :: forall b (m :: * -> *) a.
(NFData b, Monad m) =>
(a -> m b) -> [a] -> m [b]
mapMRnf a -> m b
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
mapMRnf a -> m b
f (a
x:[a]
xs) = do
  !(forall a. NFData a => a -> a
force -> b
x') <- a -> m b
f a
x
  (b
x' forall a. a -> [a] -> [a]
:) forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall b (m :: * -> *) a.
(NFData b, Monad m) =>
(a -> m b) -> [a] -> m [b]
mapMRnf a -> m b
f [a]
xs
-- mapMRnf :: (NFData b, Monad m) => (a -> m b) -> [a] -> m [b]
-- mapMRnf = mapM


genExperiment :: (ExperimentDef a) => Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
genExperiment :: forall a.
ExperimentDef a =>
Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
genExperiment Experiment a
exp (Named StatsDef a
eval ByteString
name) = EvalResults a -> EvalResults a
addName forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
genExperiment Experiment a
exp StatsDef a
eval
  where addName :: EvalResults a -> EvalResults a
addName EvalResults a
res = EvalResults a
res { _evalType :: StatsDef a
_evalType = forall a. StatsDef a -> ByteString -> StatsDef a
Named (EvalResults a
res forall s a. s -> Getting a s a -> a
^. forall a. Lens' (EvalResults a) (StatsDef a)
evalType) ByteString
name }
genExperiment Experiment a
exp (Name ByteString
name StatsDef a
eval) = EvalResults a -> EvalResults a
addName forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
genExperiment Experiment a
exp StatsDef a
eval
  where addName :: EvalResults a -> EvalResults a
addName EvalResults a
res = EvalResults a
res { _evalType :: StatsDef a
_evalType = forall a. StatsDef a -> ByteString -> StatsDef a
Named (EvalResults a
res forall s a. s -> Getting a s a -> a
^. forall a. Lens' (EvalResults a) (StatsDef a)
evalType) ByteString
name }
genExperiment Experiment a
exp StatsDef a
eval =
  case StatsDef a
eval of
    Mean Over a
OverExperimentRepetitions (Stats StatsDef a
eval')   -> Of a -> [EvalResults a] -> EvalResults a
reduce (forall a. StatsDef a -> Of a
Stats StatsDef a
eval') forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes forall a. a -> a
id StatsDef a
eval'
    Mean Over a
OverExperimentRepetitions Of a
eval'           -> Of a -> [EvalResults a] -> EvalResults a
reduce Of a
eval' forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes forall a. a -> a
id (forall a. Of a -> StatsDef a
Id Of a
eval')
    Sum Over a
OverExperimentRepetitions (Stats StatsDef a
eval')    -> Of a -> [EvalResults a] -> EvalResults a
reduce (forall a. StatsDef a -> Of a
Stats StatsDef a
eval') forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes forall a. a -> a
id StatsDef a
eval'
    Sum Over a
OverExperimentRepetitions Of a
eval'            -> Of a -> [EvalResults a] -> EvalResults a
reduce Of a
eval' forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes forall a. a -> a
id (forall a. Of a -> StatsDef a
Id Of a
eval')
    StdDev Over a
OverExperimentRepetitions (Stats StatsDef a
eval') -> Of a -> [EvalResults a] -> EvalResults a
reduce (forall a. StatsDef a -> Of a
Stats StatsDef a
eval') forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes forall a. a -> a
id StatsDef a
eval'
    StdDev Over a
OverExperimentRepetitions Of a
eval'         -> Of a -> [EvalResults a] -> EvalResults a
reduce Of a
eval' forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes forall a. a -> a
id (forall a. Of a -> StatsDef a
Id Of a
eval')
    -- Mean (OverBestXExperimentRepetitions nr cmp) eval' -> reduce eval' <$> genExpRes (take nr . sortBy (cmp `on` id)) (Id eval')
    -- Sum (OverBestXExperimentRepetitions nr cmp) eval' -> reduce eval' <$> genExpRes (take nr . sortBy (cmp `on` id)) (Id eval')
    -- StdDev (OverBestXExperimentRepetitions nr cmp) eval' -> reduce eval' <$> genExpRes (take nr . sortBy (cmp `on` id)) (Id eval')
    StatsDef a
_ -> [EvalResults a] -> EvalResults a
packGenRes forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes forall a. a -> a
id StatsDef a
eval
  where
    packGenRes :: [EvalResults a] -> EvalResults a
packGenRes = forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector StatsDef a
eval Unit
UnitExperimentRepetition
    genExpRes :: ([ExperimentResult a] -> [ExperimentResult a])
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genExpRes [ExperimentResult a] -> [ExperimentResult a]
f StatsDef a
e = forall b (m :: * -> *) a.
(NFData b, Monad m) =>
(a -> m b) -> [a] -> m [b]
mapMRnf (forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ExperimentResult a -> DB (ExpM a) (EvalResults a)
genExperimentResult Experiment a
exp StatsDef a
e) ([ExperimentResult a] -> [ExperimentResult a]
f forall a b. (a -> b) -> a -> b
$ Experiment a
exp forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults)
    -- reduce = reduceUnary eval . EvalVector eval UnitExperimentRepetition
    reduce :: Of a -> [EvalResults a] -> EvalResults a
reduce Of a
eval' = forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (forall a. Of a -> StatsDef a
Id Of a
eval') Unit
UnitExperimentRepetition


genExperimentResult :: (ExperimentDef a) => Experiment a -> StatsDef a -> ExperimentResult a -> DB (ExpM a) (EvalResults a)
genExperimentResult :: forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ExperimentResult a -> DB (ExpM a) (EvalResults a)
genExperimentResult Experiment a
_ (Named StatsDef a
_ ByteString
n) ExperimentResult a
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"An evaluation may only be named on the outermost function in evaluation " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (ByteString -> Text
E.decodeUtf8 ByteString
n)
genExperimentResult Experiment a
_ (Name ByteString
n StatsDef a
_) ExperimentResult a
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"An evaluation may only be named on the outermost function in evaluation " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (ByteString -> Text
E.decodeUtf8 ByteString
n)
genExperimentResult Experiment a
exp StatsDef a
eval ExperimentResult a
expRes =
  case StatsDef a
eval of
    Mean Over a
OverReplications (Stats StatsDef a
eval')   -> [EvalResults a] -> EvalResults a
reduce forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl StatsDef a
eval'
    Mean Over a
OverReplications Of a
eval'           -> [EvalResults a] -> EvalResults a
reduce forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl (forall a. Of a -> StatsDef a
Id Of a
eval')
    StdDev Over a
OverReplications (Stats StatsDef a
eval') -> [EvalResults a] -> EvalResults a
reduce forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl StatsDef a
eval'
    StdDev Over a
OverReplications Of a
eval'         -> [EvalResults a] -> EvalResults a
reduce forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl (forall a. Of a -> StatsDef a
Id Of a
eval')
    Sum Over a
OverReplications (Stats StatsDef a
eval')    -> [EvalResults a] -> EvalResults a
reduce forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl StatsDef a
eval'
    Sum Over a
OverReplications Of a
eval'            -> [EvalResults a] -> EvalResults a
reduce forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl (forall a. Of a -> StatsDef a
Id Of a
eval')
    StatsDef a
_                                     -> [EvalResults a] -> EvalResults a
packGenRes forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl StatsDef a
eval
  where
    packGenRes :: [EvalResults a] -> EvalResults a
packGenRes = forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector StatsDef a
eval Unit
UnitReplications
    -- genRepl e = mapMRnf (fmap force . genReplication exp e) (expRes ^. evaluationResults)
    genRepl :: StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl StatsDef a
e = forall b (m :: * -> *) a.
(NFData b, Monad m) =>
(a -> m b) -> [a] -> m [b]
mapMRnf (forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a
-> Int
-> ReplicationResult a
-> DB (ExpM a) (EvalResults a)
genReplication Experiment a
exp StatsDef a
e (ExperimentResult a
expRes forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ExperimentResult a) Int
repetitionNumber)) (ExperimentResult a
expRes forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\ReplicationResult a
x -> forall a. Maybe a -> Bool
isJust (ReplicationResult a
x forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults)))
    reduce :: [EvalResults a] -> EvalResults a
reduce ![EvalResults a]
inp = forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector StatsDef a
eval (forall {a}. [EvalResults a] -> Unit
getUnit [EvalResults a]
inp) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval) forall a b. (a -> b) -> a -> b
$ forall a. Unit -> [EvalResults a] -> [EvalResults a]
transpose Unit
UnitReplications [EvalResults a]
inp
    getUnit :: [EvalResults a] -> Unit
getUnit (EvalVector StatsDef a
_ Unit
unit [EvalResults a]
_:[EvalResults a]
_) = Unit
unit
    getUnit (EvalValue StatsDef a
_ Unit
unit ByteString
_ Either Int Double
_ Double
_:[EvalResults a]
_) = Unit
unit
    getUnit (EvalReducedValue StatsDef a
_ Unit
unit Double
_:[EvalResults a]
_) = Unit
unit
    getUnit [] = forall a. HasCallStack => [Char] -> a
error [Char]
"Unexpected empty data in getUnit in genExperimentResult in Eval.Ops"


genReplication :: (ExperimentDef a) => Experiment a -> StatsDef a -> Int -> ReplicationResult a -> DB (ExpM a) (EvalResults a)
genReplication :: forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a
-> Int
-> ReplicationResult a
-> DB (ExpM a) (EvalResults a)
genReplication Experiment a
exp StatsDef a
eval Int
repNr ReplicationResult a
repl =
  forall (m :: * -> *) t.
(MonadIO m, NFData t) =>
[Char] -> m t -> m t
mkTime ([Char]
"\tExperiment " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (Experiment a
exp forall s a. s -> Getting a s a -> a
^. forall a. Lens' (Experiment a) Int
experimentNumber) forall a. Semigroup a => a -> a -> a
<> [Char]
" Repetition " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Int
repNr forall a. Semigroup a => a -> a -> a
<> [Char]
" Replication" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show (ReplicationResult a
repl forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ReplicationResult a) Int
replicationNumber)) forall a b. (a -> b) -> a -> b
$
  forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Evaluation data is incomplete!") forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp StatsDef a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (ReplicationResult a
repl forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults))


-- stddevSamp     :: (E.PersistField a, E.PersistField b) => E.SqlExpr (E.Value a) -> E.SqlExpr (E.Value (Maybe b))
-- stddevSamp     = unsafeSqlFunction "SUM"
--   where -- | (Internal) A raw SQL function.  Once again, the same warning
--        -- from 'unsafeSqlBinOp' applies to this function as well.
--        -- unsafeSqlFunction :: E.UnsafeSqlFunctionArgument a =>
--        --                      TLB.Builder -> a -> SqlExpr (Value b)
--        unsafeSqlFunction name arg =
--          ERaw Never $ \info ->
--            let (argsTLB, argsVals) =
--                  uncommas' $ map (\(E.ERaw _ f) -> f info) $ toArgList arg
--            in (name <> parens argsTLB, argsVals)

genResultData :: (ExperimentDef a) => Experiment a -> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData :: forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
_ (Named StatsDef a
_ ByteString
n) ResultData a
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"An evaluation may only be named on the outermost function in evaluation " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (ByteString -> Text
E.decodeUtf8 ByteString
n)
genResultData Experiment a
_ (Name ByteString
n StatsDef a
_) ResultData a
_ = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"An evaluation may only be named on the outermost function in evaluation " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack (ByteString -> Text
E.decodeUtf8 ByteString
n)
genResultData Experiment a
exp StatsDef a
eval ResultData a
resData =
  case StatsDef a
eval of
    Mean Over a
OverPeriods (Of ByteString
name) -> ByteString -> AggregateFunction -> DB (ExpM a) (EvalResults a)
aggregate ByteString
name forall a b.
(PersistField a, PersistField b) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
E.avg_
    Mean Over a
OverPeriods Of a
eval' -> forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp (forall a. Of a -> StatsDef a
Id Of a
eval') ResultData a
resData
    -- StdDev OverPeriods (Of name) -> aggregate name E.stdDev_ -- not available in esqueleto :-o
    StdDev Over a
OverPeriods Of a
eval' -> forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp (forall a. Of a -> StatsDef a
Id Of a
eval') ResultData a
resData
    Sum Over a
OverPeriods (Of ByteString
name) -> ByteString -> AggregateFunction -> DB (ExpM a) (EvalResults a)
aggregate ByteString
name forall a b.
(PersistField a, PersistField b) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
E.sum_
    Sum Over a
OverPeriods Of a
eval' -> forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp (forall a. Of a -> StatsDef a
Id Of a
eval') ResultData a
resData
    Id Of a
eval' -> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval' ResultData a
resData
    StatsDef a
_ -> forall a.
ExperimentDef a =>
Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
genExperiment Experiment a
exp StatsDef a
eval
  where
    aggregate :: ByteString -> AggregateFunction -> DB (ExpM a) (EvalResults a)
aggregate ByteString
name AggregateFunction
agg =
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. StatsDef a -> Unit -> Double -> EvalResults a
EvalReducedValue StatsDef a
eval Unit
UnitPeriods) forall a b. (a -> b) -> a -> b
$
      case ResultData a
resData forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep Key PrepResultData
k   -> forall (m :: * -> *).
MonadIO m =>
Key PrepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadPreparationAggregateWhere Key PrepResultData
k AggregateFunction
agg (ByteString -> AvailabilityListWhere
whereName ByteString
name)
        ResultDataWarmUp Key WarmUpResultData
k -> forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReplicationWarmUpAggregateWhere Key WarmUpResultData
k AggregateFunction
agg (ByteString -> AvailabilityListWhere
whereName ByteString
name)
        ResultDataRep Key RepResultData
k    -> forall (m :: * -> *).
MonadIO m =>
Key RepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReparationAggregateWhere Key RepResultData
k AggregateFunction
agg (ByteString -> AvailabilityListWhere
whereName ByteString
name)
    whereName :: ByteString -> AvailabilityListWhere
whereName ByteString
name =
      case ResultData a
resData forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep{} -> (SqlExpr (Entity PrepMeasure)
 -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
PrepMeasureWhere forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity PrepMeasure)
_ SqlExpr (Entity PrepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepResultStep)
resStep forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField PrepResultStep typ
PrepResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name))
        ResultDataWarmUp{} -> (SqlExpr (Entity WarmUpMeasure)
 -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
-> AvailabilityListWhere
WarmUpMeasureWhere forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity WarmUpMeasure)
_ SqlExpr (Entity WarmUpResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpResultStep)
resStep forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField WarmUpResultStep typ
WarmUpResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name))
        ResultDataRep{} -> (SqlExpr (Entity RepMeasure)
 -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
RepMeasureWhere forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity RepMeasure)
_ SqlExpr (Entity RepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepResultStep)
resStep forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField RepResultStep typ
RepResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name))


evalOf :: (ExperimentDef a) => Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf :: forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval ResultData a
resData =
  case Of a
eval of
    Of ByteString
name -> do
      -- mCache <- liftIO $ lookupCache (eval, resData ^. resultDataKey)
      -- case mCache of
        -- Nothing -> do
        --   res <- runConduit $ srcAvailableListWhere (whereName name) (resData ^. results) .| mapC (fromMeasure $ E.decodeUtf8 name) .| CL.consume
        --   let evalVector = EvalVector (Id $ Of name) UnitPeriods res
        --   liftIO $ addCache (eval, resData ^. resultDataKey) evalVector
        --   return evalVector
        -- Just evalVector -> return evalVector
      ----
      [EvalResults a]
res <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
AvailabilityListWhere
-> AvailabilityList m a -> ConduitT () a (DB m) ()
srcAvailableListWhere (ByteString -> AvailabilityListWhere
whereName ByteString
name) (ResultData a
resData forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (forall a. Text -> Measure -> EvalResults a
fromMeasure forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
      let evalVector :: EvalResults a
evalVector = forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitPeriods [EvalResults a]
res
      forall (m :: * -> *) a. Monad m => a -> m a
return EvalResults a
evalVector

    Stats StatsDef a
def -- alter experiment and restart evaluation
      | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Ord a => a -> a -> Bool
> forall a. Over a
OverPeriods) (forall a. StatsDef a -> Maybe (Over a)
getOver StatsDef a
def) -> do
        forall a. HasCallStack => [Char] -> a
error [Char]
"OverExperimentRepetitions and OverReplications have to be the two outermost evaluations or not present"
        -- let k = resData ^. resultDataKey
        --     isK = (== k)
        --     check Nothing = Nothing
        --     check (Just rD)
        --       | isK (rD ^. resultDataKey) = Just rD
        --       | otherwise = Nothing
        --     fil lns = over lns check
        -- let exp' = over (experimentResults . traversed) (over (evaluationResults . traversed) (fil warmUpResults . fil evalResults) . over preparationResults check) exp
        --     allResData x = x ^.. evaluationResults . traversed . evalResults . traversed ++ x ^.. evaluationResults . traversed . warmUpResults . traversed ++ x ^.. preparationResults . traversed
        --     expFiltered = over experimentResults (filter (not . null . allResData)) exp'
        -- liftIO $ putStrLn $ "Filtered: " ++ show (length $ concatMap allResData (expFiltered ^. experimentResults))
        -- genExperiment expFiltered def
    Stats StatsDef a
def -> forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp StatsDef a
def ResultData a
resData
    Div Of a
eval1 Of a
eval2 -> forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval1 ResultData a
resData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval2 ResultData a
resData
    Add Of a
eval1 Of a
eval2 -> forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval1 ResultData a
resData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval2 ResultData a
resData
    Sub Of a
eval1 Of a
eval2 -> forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval1 ResultData a
resData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval2 ResultData a
resData
    Mult Of a
eval1 Of a
eval2 -> forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval1 ResultData a
resData forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval2 ResultData a
resData
    First (Of ByteString
name) -> do

      -- res <- aggregate (E.orderBy [E.asc (repM E.^. RepMeasurePeriod)]) name

      -- todo: sorting!!!
      Maybe (EvalResults a)
res <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
AvailabilityListWhere
-> AvailabilityList m a -> ConduitT () a (DB m) ()
srcAvailableListWhere (SqlQuery () -> ByteString -> AvailabilityListWhere
whereName' (Int64 -> SqlQuery ()
E.limit Int64
1) ByteString
name) (ResultData a
resData forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (forall a. Text -> Measure -> EvalResults a
fromMeasure forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. Of a -> Of a
First forall a b. (a -> b) -> a -> b
$ forall a. StatsDef a -> Of a
Stats forall a b. (a -> b) -> a -> b
$ forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitPeriods [forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"empty elements in evalOf First(Of " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show ByteString
name forall a. Semigroup a => a -> a -> a
<> [Char]
")") Maybe (EvalResults a)
res]
    First Of a
eval' -> forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval' ResultData a
resData
    Last (Of ByteString
name) -> do
      Maybe (EvalResults a)
res <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
AvailabilityListWhere
-> AvailabilityList m a -> ConduitT () a (DB m) ()
srcAvailableListWhere (ByteString -> AvailabilityListWhere
whereName ByteString
name) (ResultData a
resData forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (forall a. Text -> Measure -> EvalResults a
fromMeasure forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
lastC
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. Of a -> Of a
Last forall a b. (a -> b) -> a -> b
$ forall a. StatsDef a -> Of a
Stats forall a b. (a -> b) -> a -> b
$ forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitPeriods [forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"empty elements in evalOf Last(Of " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show ByteString
name forall a. Semigroup a => a -> a -> a
<> [Char]
")") Maybe (EvalResults a)
res]
    Last Of a
eval' -> forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval' ResultData a
resData
    EveryXthElem Int
_ Of a
eval' -> forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval' ResultData a
resData
    Length (Of ByteString
name) -> do
      Double
res <- forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
AvailabilityListWhere
-> AvailabilityList m a -> ConduitT () a (DB m) ()
srcAvailableListWhere (ByteString -> AvailabilityListWhere
whereName ByteString
name) (ResultData a
resData forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (forall a. Text -> Measure -> EvalResults a
fromMeasure forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| forall (m :: * -> *) len a o.
(Monad m, Num len) =>
ConduitT a o m len
lengthC
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. StatsDef a -> Unit -> Double -> EvalResults a
EvalReducedValue (forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. Of a -> Of a
Length forall a b. (a -> b) -> a -> b
$ forall a. StatsDef a -> Of a
Stats forall a b. (a -> b) -> a -> b
$ forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitScalar Double
res
    Length Of a
eval' -> forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall a.
ExperimentDef a =>
Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
evalOf Experiment a
exp Of a
eval' ResultData a
resData
  where
    whereName :: ByteString -> AvailabilityListWhere
whereName = SqlQuery () -> ByteString -> AvailabilityListWhere
whereName' (forall (m :: * -> *) a. Monad m => a -> m a
return ())
    whereName' :: SqlQuery () -> ByteString -> AvailabilityListWhere
whereName' SqlQuery ()
add ByteString
name =
      case ResultData a
resData forall s a. s -> Getting a s a -> a
^. forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep Key PrepResultData
_ -> (SqlExpr (Entity PrepMeasure)
 -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
PrepMeasureWhere forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity PrepMeasure)
_ SqlExpr (Entity PrepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepResultStep)
resStep forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField PrepResultStep typ
PrepResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlQuery ()
add
        ResultDataWarmUp Key WarmUpResultData
_ -> (SqlExpr (Entity WarmUpMeasure)
 -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
-> AvailabilityListWhere
WarmUpMeasureWhere forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity WarmUpMeasure)
_ SqlExpr (Entity WarmUpResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpResultStep)
resStep forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField WarmUpResultStep typ
WarmUpResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlQuery ()
add
        ResultDataRep Key RepResultData
_ -> (SqlExpr (Entity RepMeasure)
 -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
RepMeasureWhere forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity RepMeasure)
_ SqlExpr (Entity RepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepResultStep)
resStep forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Text) => EntityField RepResultStep typ
RepResultStepName forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name)) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlQuery ()
add
    -- aggregate add name agg =
    --     case resData ^. resultDataKey of
    --       ResultDataPrep k   -> loadPreparationAggregateWhere k agg (whereName' add name)
    --       ResultDataWarmUp k -> loadReplicationWarmUpAggregateWhere k agg (whereName' add name)
    --       ResultDataRep k    -> loadReparationAggregateWhere k agg (whereName' add name)

fromMeasure :: T.Text -> Measure -> EvalResults a
fromMeasure :: forall a. Text -> Measure -> EvalResults a
fromMeasure Text
name (Measure Int
p [StepResult]
res) = case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((forall a. Eq a => a -> a -> Bool
==Text
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' StepResult Text
resultName) [StepResult]
res of
  Maybe StepResult
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Variable with name " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
name forall a. Semigroup a => a -> a -> a
<> [Char]
" could not be found!"
  Just (StepResult Text
n Maybe Double
mX Double
y) -> forall a.
StatsDef a
-> Unit
-> ByteString
-> Either Int Double
-> Double
-> EvalResults a
EvalValue (forall a. Of a -> StatsDef a
Id forall a b. (a -> b) -> a -> b
$ forall a. ByteString -> Of a
Of forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
n) Unit
UnitPeriods (Text -> ByteString
E.encodeUtf8 Text
n) (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Int
p) forall a b. b -> Either a b
Right Maybe Double
mX) Double
y