{-# 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 :: DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
genEvalsIO = (ExpM a (Evals a) -> IO (Evals a))
-> DatabaseSetting -> Experiments a -> [StatsDef a] -> IO (Evals a)
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)
forall a. a -> a
id


genEvals :: (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))
-> 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 (ExpM a (Evals a) -> IO (Evals a))
-> ExpM a (Evals a) -> IO (Evals a)
forall a b. (a -> b) -> a -> b
$ (ResourceT (ExpM a) (Evals a) -> ExpM a (Evals a))
-> DatabaseSetting
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Evals a)
-> ExpM a (Evals a)
forall (m1 :: * -> *) a (m :: * -> *).
MonadUnliftIO m1 =>
(m1 a -> m a)
-> DatabaseSetting -> ReaderT SqlBackend (LoggingT m1) a -> m a
runDBWithM ResourceT (ExpM a) (Evals a) -> ExpM a (Evals a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT DatabaseSetting
dbSetup (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Evals a)
 -> ExpM a (Evals a))
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Evals a)
-> ExpM a (Evals a)
forall a b. (a -> b) -> a -> b
$ do
  [ExperimentEval a]
res <- (Experiment a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentEval a))
-> [Experiment a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentEval a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([StatsDef a]
-> Experiment a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentEval a)
forall a.
ExperimentDef a =>
[StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a)
mkEvals [StatsDef a]
evals) (Experiments a
exps Experiments a
-> Getting [Experiment a] (Experiments a) [Experiment a]
-> [Experiment a]
forall s a. s -> Getting a s a -> a
^. Getting [Experiment a] (Experiments a) [Experiment a]
forall a. Lens' (Experiments a) [Experiment a]
experiments)
  Evals a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Evals a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Evals a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Evals a))
-> Evals a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Evals a)
forall a b. (a -> b) -> a -> b
$ Experiments a -> [ExperimentEval a] -> Evals a
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 :: 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 <- Int
-> (Experiment a -> IO (ExperimentEval a))
-> [Experiment a]
-> IO [ExperimentEval a]
forall b a. NFData b => Int -> (a -> IO b) -> [a] -> IO [b]
mapConurrentIO Int
parallelWorkers (ExpM a (ExperimentEval a) -> IO (ExperimentEval a)
runExpM (ExpM a (ExperimentEval a) -> IO (ExperimentEval a))
-> (Experiment a -> ExpM a (ExperimentEval a))
-> Experiment a
-> IO (ExperimentEval a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResourceT (ExpM a) (ExperimentEval a)
 -> ExpM a (ExperimentEval a))
-> DatabaseSetting
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentEval a)
-> ExpM a (ExperimentEval a)
forall (m1 :: * -> *) a (m :: * -> *).
MonadUnliftIO m1 =>
(m1 a -> m a)
-> DatabaseSetting -> ReaderT SqlBackend (LoggingT m1) a -> m a
runDBWithM ResourceT (ExpM a) (ExperimentEval a) -> ExpM a (ExperimentEval a)
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT DatabaseSetting
dbSetup (ReaderT
   SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentEval a)
 -> ExpM a (ExperimentEval a))
-> (Experiment a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentEval a))
-> Experiment a
-> ExpM a (ExperimentEval a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [StatsDef a]
-> Experiment a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentEval a)
forall a.
ExperimentDef a =>
[StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a)
mkEvals [StatsDef a]
evals) (Experiments a
exps Experiments a
-> Getting [Experiment a] (Experiments a) [Experiment a]
-> [Experiment a]
forall s a. s -> Getting a s a -> a
^. Getting [Experiment a] (Experiments a) [Experiment a]
forall a. Lens' (Experiments a) [Experiment a]
experiments)
  Evals a -> IO (Evals a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Evals a -> IO (Evals a)) -> Evals a -> IO (Evals a)
forall a b. (a -> b) -> a -> b
$ Experiments a -> [ExperimentEval a] -> Evals a
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 :: [StatsDef a] -> Experiment a -> DB (ExpM a) (ExperimentEval a)
mkEvals [StatsDef a]
evals Experiment a
e = do
  IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Evaluating Experiment " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show (Experiment a
e Experiment a -> Getting Int (Experiment a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Experiment a) Int
forall a. Lens' (Experiment a) Int
experimentNumber)
  [Availability IO (EvalResults a)]
xs <- String
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Availability IO (EvalResults a)]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Availability IO (EvalResults a)]
forall (m :: * -> *) t.
(MonadIO m, NFData t) =>
String -> m t -> m t
mkTime String
"All Experiment Evaluations" (ReaderT
   SqlBackend
   (LoggingT (ResourceT (ExpM a)))
   [Availability IO (EvalResults a)]
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      [Availability IO (EvalResults a)])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Availability IO (EvalResults a)]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Availability IO (EvalResults a)]
forall a b. (a -> b) -> a -> b
$ (StatsDef a
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Availability IO (EvalResults a)))
-> [StatsDef a]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Availability IO (EvalResults a)]
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
  ExperimentEval a -> DB (ExpM a) (ExperimentEval a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExperimentEval a -> DB (ExpM a) (ExperimentEval a))
-> ExperimentEval a -> DB (ExpM a) (ExperimentEval a)
forall a b. (a -> b) -> a -> b
$ ExperimentEval a -> ExperimentEval a
forall a. NFData a => a -> a
force (ExperimentEval a -> ExperimentEval a)
-> ExperimentEval a -> ExperimentEval a
forall a b. (a -> b) -> a -> b
$ Int
-> [Availability IO (EvalResults a)]
-> Experiment a
-> ExperimentEval a
forall a.
Int
-> [Availability IO (EvalResults a)]
-> Experiment a
-> ExperimentEval a
ExperimentEval (Experiment a
e Experiment a -> Getting Int (Experiment a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Experiment a) Int
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
      EvalResults a -> Availability IO (EvalResults a)
forall (m :: * -> *) b. b -> Availability m b
Available (EvalResults a -> Availability IO (EvalResults a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (EvalResults a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Availability IO (EvalResults a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Experiment a
-> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (EvalResults a)
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 :: (a -> m b) -> [a] -> m [b]
mapMRnf a -> m b
_ [] = [b] -> m [b]
forall (m :: * -> *) a. Monad m => a -> m a
return []
mapMRnf a -> m b
f (a
x:[a]
xs) = do
  !(b -> b
forall a. NFData a => a -> a
force -> b
x') <- a -> m b
f a
x
  (b
x' b -> [b] -> [b]
forall a. a -> [a] -> [a]
:) ([b] -> [b]) -> m [b] -> m [b]
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (a -> m b) -> [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 :: Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
genExperiment Experiment a
exp (Named StatsDef a
eval ByteString
name) = EvalResults a -> EvalResults a
addName (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
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 = StatsDef a -> ByteString -> StatsDef a
forall a. StatsDef a -> ByteString -> StatsDef a
Named (EvalResults a
res EvalResults a
-> Getting (StatsDef a) (EvalResults a) (StatsDef a) -> StatsDef a
forall s a. s -> Getting a s a -> a
^. Getting (StatsDef a) (EvalResults a) (StatsDef 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 (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults a)
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 = StatsDef a -> ByteString -> StatsDef a
forall a. StatsDef a -> ByteString -> StatsDef a
Named (EvalResults a
res EvalResults a
-> Getting (StatsDef a) (EvalResults a) (StatsDef a) -> StatsDef a
forall s a. s -> Getting a s a -> a
^. Getting (StatsDef a) (EvalResults a) (StatsDef 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 (StatsDef a -> Of a
forall a. StatsDef a -> Of a
Stats StatsDef a
eval') ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 [ExperimentResult a] -> [ExperimentResult a]
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' ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 [ExperimentResult a] -> [ExperimentResult a]
forall a. a -> a
id (Of a -> StatsDef a
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 (StatsDef a -> Of a
forall a. StatsDef a -> Of a
Stats StatsDef a
eval') ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 [ExperimentResult a] -> [ExperimentResult a]
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' ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 [ExperimentResult a] -> [ExperimentResult a]
forall a. a -> a
id (Of a -> StatsDef a
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 (StatsDef a -> Of a
forall a. StatsDef a -> Of a
Stats StatsDef a
eval') ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 [ExperimentResult a] -> [ExperimentResult a]
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' ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 [ExperimentResult a] -> [ExperimentResult a]
forall a. a -> a
id (Of a -> StatsDef a
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 ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 [ExperimentResult a] -> [ExperimentResult a]
forall a. a -> a
id StatsDef a
eval
  where
    packGenRes :: [EvalResults a] -> EvalResults a
packGenRes = StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
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 = (ExperimentResult a -> DB (ExpM a) (EvalResults a))
-> [ExperimentResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
forall b (m :: * -> *) a.
(NFData b, Monad m) =>
(a -> m b) -> [a] -> m [b]
mapMRnf (Experiment a
-> StatsDef a -> ExperimentResult a -> DB (ExpM a) (EvalResults a)
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 ([ExperimentResult a] -> [ExperimentResult a])
-> [ExperimentResult a] -> [ExperimentResult a]
forall a b. (a -> b) -> a -> b
$ Experiment a
exp Experiment a
-> Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
-> [ExperimentResult a]
forall s a. s -> Getting a s a -> a
^. Getting [ExperimentResult a] (Experiment a) [ExperimentResult 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' = StatsDef a -> EvalResults a -> EvalResults a
forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval (EvalResults a -> EvalResults a)
-> ([EvalResults a] -> EvalResults a)
-> [EvalResults a]
-> EvalResults a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (Of a -> StatsDef a
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 :: Experiment a
-> StatsDef a -> ExperimentResult a -> DB (ExpM a) (EvalResults a)
genExperimentResult Experiment a
_ (Named StatsDef a
_ ByteString
n) ExperimentResult a
_ = String -> DB (ExpM a) (EvalResults a)
forall a. HasCallStack => String -> a
error (String -> DB (ExpM a) (EvalResults a))
-> String -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$ String
"An evaluation may only be named on the outermost function in evaluation " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ByteString -> Text
E.decodeUtf8 ByteString
n)
genExperimentResult Experiment a
_ (Name ByteString
n StatsDef a
_) ExperimentResult a
_ = String -> DB (ExpM a) (EvalResults a)
forall a. HasCallStack => String -> a
error (String -> DB (ExpM a) (EvalResults a))
-> String -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$ String
"An evaluation may only be named on the outermost function in evaluation " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
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 ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id Of a
eval')
    StdDev Over a
OverReplications (Stats StatsDef a
eval') -> [EvalResults a] -> EvalResults a
reduce ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id Of a
eval')
    Sum Over a
OverReplications (Stats StatsDef a
eval')    -> [EvalResults a] -> EvalResults a
reduce ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> StatsDef a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
genRepl (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id Of a
eval')
    StatsDef a
_                                     -> [EvalResults a] -> EvalResults a
packGenRes ([EvalResults a] -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
-> DB (ExpM a) (EvalResults a)
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 = StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
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 = (ReplicationResult a -> DB (ExpM a) (EvalResults a))
-> [ReplicationResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [EvalResults a]
forall b (m :: * -> *) a.
(NFData b, Monad m) =>
(a -> m b) -> [a] -> m [b]
mapMRnf (Experiment a
-> StatsDef a
-> Int
-> ReplicationResult a
-> DB (ExpM a) (EvalResults a)
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 ExperimentResult a -> Getting Int (ExperimentResult a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (ExperimentResult a) Int
forall a. Lens' (ExperimentResult a) Int
repetitionNumber)) (ExperimentResult a
expRes ExperimentResult a
-> Getting
     (Endo [ReplicationResult a])
     (ExperimentResult a)
     (ReplicationResult a)
-> [ReplicationResult a]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([ReplicationResult a]
 -> Const (Endo [ReplicationResult a]) [ReplicationResult a])
-> ExperimentResult a
-> Const (Endo [ReplicationResult a]) (ExperimentResult a)
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults (([ReplicationResult a]
  -> Const (Endo [ReplicationResult a]) [ReplicationResult a])
 -> ExperimentResult a
 -> Const (Endo [ReplicationResult a]) (ExperimentResult a))
-> ((ReplicationResult a
     -> Const (Endo [ReplicationResult a]) (ReplicationResult a))
    -> [ReplicationResult a]
    -> Const (Endo [ReplicationResult a]) [ReplicationResult a])
-> Getting
     (Endo [ReplicationResult a])
     (ExperimentResult a)
     (ReplicationResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplicationResult a
 -> Const (Endo [ReplicationResult a]) (ReplicationResult a))
-> [ReplicationResult a]
-> Const (Endo [ReplicationResult a]) [ReplicationResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ReplicationResult a
  -> Const (Endo [ReplicationResult a]) (ReplicationResult a))
 -> [ReplicationResult a]
 -> Const (Endo [ReplicationResult a]) [ReplicationResult a])
-> ((ReplicationResult a
     -> Const (Endo [ReplicationResult a]) (ReplicationResult a))
    -> ReplicationResult a
    -> Const (Endo [ReplicationResult a]) (ReplicationResult a))
-> (ReplicationResult a
    -> Const (Endo [ReplicationResult a]) (ReplicationResult a))
-> [ReplicationResult a]
-> Const (Endo [ReplicationResult a]) [ReplicationResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplicationResult a -> Bool)
-> (ReplicationResult a
    -> Const (Endo [ReplicationResult a]) (ReplicationResult a))
-> ReplicationResult a
-> Const (Endo [ReplicationResult a]) (ReplicationResult a)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (\ReplicationResult a
x -> Maybe (ResultData a) -> Bool
forall a. Maybe a -> Bool
isJust (ReplicationResult a
x ReplicationResult a
-> Getting
     (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults)))
    reduce :: [EvalResults a] -> EvalResults a
reduce ![EvalResults a]
inp = StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector StatsDef a
eval ([EvalResults a] -> Unit
forall a. [EvalResults a] -> Unit
getUnit [EvalResults a]
inp) ([EvalResults a] -> EvalResults a)
-> [EvalResults a] -> EvalResults a
forall a b. (a -> b) -> a -> b
$ (EvalResults a -> EvalResults a)
-> [EvalResults a] -> [EvalResults a]
forall a b. (a -> b) -> [a] -> [b]
map (StatsDef a -> EvalResults a -> EvalResults a
forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval) ([EvalResults a] -> [EvalResults a])
-> [EvalResults a] -> [EvalResults a]
forall a b. (a -> b) -> a -> b
$ Unit -> [EvalResults a] -> [EvalResults a]
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 [] = String -> Unit
forall a. HasCallStack => String -> a
error String
"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 :: Experiment a
-> StatsDef a
-> Int
-> ReplicationResult a
-> DB (ExpM a) (EvalResults a)
genReplication Experiment a
exp StatsDef a
eval Int
repNr ReplicationResult a
repl =
  String
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) t.
(MonadIO m, NFData t) =>
String -> m t -> m t
mkTime (String
"\tExperiment " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (Experiment a
exp Experiment a -> Getting Int (Experiment a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Experiment a) Int
forall a. Lens' (Experiment a) Int
experimentNumber) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" Repetition " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
repNr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" Replication" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show (ReplicationResult a
repl ReplicationResult a -> Getting Int (ReplicationResult a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (ReplicationResult a) Int
forall a. Lens' (ReplicationResult a) Int
replicationNumber)) (DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a))
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$
  EvalResults a -> Maybe (EvalResults a) -> EvalResults a
forall a. a -> Maybe a -> a
fromMaybe (String -> EvalResults a
forall a. HasCallStack => String -> a
error String
"Evaluation data is incomplete!") (Maybe (EvalResults a) -> EvalResults a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (EvalResults a))
-> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Maybe (DB (ExpM a) (EvalResults a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (EvalResults a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp StatsDef a
eval (ResultData a -> DB (ExpM a) (EvalResults a))
-> Maybe (ResultData a) -> Maybe (DB (ExpM a) (EvalResults a))
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (ReplicationResult a
repl ReplicationResult a
-> Getting
     (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData 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 :: Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
_ (Named StatsDef a
_ ByteString
n) ResultData a
_ = String -> DB (ExpM a) (EvalResults a)
forall a. HasCallStack => String -> a
error (String -> DB (ExpM a) (EvalResults a))
-> String -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$ String
"An evaluation may only be named on the outermost function in evaluation " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack (ByteString -> Text
E.decodeUtf8 ByteString
n)
genResultData Experiment a
_ (Name ByteString
n StatsDef a
_) ResultData a
_ = String -> DB (ExpM a) (EvalResults a)
forall a. HasCallStack => String -> a
error (String -> DB (ExpM a) (EvalResults a))
-> String -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$ String
"An evaluation may only be named on the outermost function in evaluation " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
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 AggregateFunction
forall a b.
(PersistField a, PersistField b) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
E.avg_
    Mean Over a
OverPeriods Of a
eval' -> StatsDef a -> EvalResults a -> EvalResults a
forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp (Of a -> StatsDef a
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' -> StatsDef a -> EvalResults a -> EvalResults a
forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp (Of a -> StatsDef a
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 AggregateFunction
forall a b.
(PersistField a, PersistField b) =>
SqlExpr (Value a) -> SqlExpr (Value (Maybe b))
E.sum_
    Sum Over a
OverPeriods Of a
eval' -> StatsDef a -> EvalResults a -> EvalResults a
forall a. StatsDef a -> EvalResults a -> EvalResults a
reduceUnary StatsDef a
eval (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
forall a.
ExperimentDef a =>
Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
genResultData Experiment a
exp (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id Of a
eval') ResultData a
resData
    Id Of a
eval' -> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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
_ -> Experiment a -> StatsDef a -> DB (ExpM a) (EvalResults 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 =
      (Double -> EvalResults a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Double
-> DB (ExpM a) (EvalResults a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StatsDef a -> Unit -> Double -> EvalResults a
forall a. StatsDef a -> Unit -> Double -> EvalResults a
EvalReducedValue StatsDef a
eval Unit
UnitPeriods) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Double
 -> DB (ExpM a) (EvalResults a))
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Double
-> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$
      case ResultData a
resData ResultData a
-> Getting ResultDataKey (ResultData a) ResultDataKey
-> ResultDataKey
forall s a. s -> Getting a s a -> a
^. Getting ResultDataKey (ResultData a) ResultDataKey
forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep Key PrepResultData
k   -> Key PrepResultData
-> AggregateFunction
-> AvailabilityListWhere
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Double
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 -> Key WarmUpResultData
-> AggregateFunction
-> AvailabilityListWhere
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Double
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    -> Key RepResultData
-> AggregateFunction
-> AvailabilityListWhere
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Double
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 ResultData a
-> Getting ResultDataKey (ResultData a) ResultDataKey
-> ResultDataKey
forall s a. s -> Getting a s a -> a
^. Getting ResultDataKey (ResultData a) ResultDataKey
forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep{} -> (SqlExpr (Entity PrepMeasure)
 -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
PrepMeasureWhere ((SqlExpr (Entity PrepMeasure)
  -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
 -> AvailabilityListWhere)
-> (SqlExpr (Entity PrepMeasure)
    -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity PrepMeasure)
_ SqlExpr (Entity PrepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepResultStep)
resStep SqlExpr (Entity PrepResultStep)
-> EntityField PrepResultStep Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepResultStep Text
forall typ. (typ ~ Text) => EntityField PrepResultStep typ
PrepResultStepName SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Text -> SqlExpr (Value Text)
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 ((SqlExpr (Entity WarmUpMeasure)
  -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
 -> AvailabilityListWhere)
-> (SqlExpr (Entity WarmUpMeasure)
    -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
-> AvailabilityListWhere
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity WarmUpMeasure)
_ SqlExpr (Entity WarmUpResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpResultStep)
resStep SqlExpr (Entity WarmUpResultStep)
-> EntityField WarmUpResultStep Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpResultStep Text
forall typ. (typ ~ Text) => EntityField WarmUpResultStep typ
WarmUpResultStepName SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Text -> SqlExpr (Value Text)
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 ((SqlExpr (Entity RepMeasure)
  -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
 -> AvailabilityListWhere)
-> (SqlExpr (Entity RepMeasure)
    -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity RepMeasure)
_ SqlExpr (Entity RepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepResultStep)
resStep SqlExpr (Entity RepResultStep)
-> EntityField RepResultStep Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepResultStep Text
forall typ. (typ ~ Text) => EntityField RepResultStep typ
RepResultStepName SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Text -> SqlExpr (Value Text)
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 :: 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 <- ConduitT () Void (DB (ExpM a)) [EvalResults a]
-> DB (ExpM a) [EvalResults a]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DB (ExpM a)) [EvalResults a]
 -> DB (ExpM a) [EvalResults a])
-> ConduitT () Void (DB (ExpM a)) [EvalResults a]
-> DB (ExpM a) [EvalResults a]
forall a b. (a -> b) -> a -> b
$ AvailabilityListWhere
-> AvailabilityList (ExpM a) Measure
-> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *) a.
AvailabilityListWhere
-> AvailabilityList m a -> ConduitT () a (DB m) ()
srcAvailableListWhere (ByteString -> AvailabilityListWhere
whereName ByteString
name) (ResultData a
resData ResultData a
-> Getting
     (AvailabilityList (ExpM a) Measure)
     (ResultData a)
     (AvailabilityList (ExpM a) Measure)
-> AvailabilityList (ExpM a) Measure
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) ConduitT () Measure (DB (ExpM a)) ()
-> ConduitM Measure Void (DB (ExpM a)) [EvalResults a]
-> ConduitT () Void (DB (ExpM a)) [EvalResults a]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Measure -> EvalResults a)
-> ConduitT Measure (EvalResults a) (DB (ExpM a)) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (Text -> Measure -> EvalResults a
forall a. Text -> Measure -> EvalResults a
fromMeasure (Text -> Measure -> EvalResults a)
-> Text -> Measure -> EvalResults a
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) ConduitT Measure (EvalResults a) (DB (ExpM a)) ()
-> ConduitM (EvalResults a) Void (DB (ExpM a)) [EvalResults a]
-> ConduitM Measure Void (DB (ExpM a)) [EvalResults a]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (EvalResults a) Void (DB (ExpM a)) [EvalResults a]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
      let evalVector :: EvalResults a
evalVector = StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ ByteString -> Of a
forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitPeriods [EvalResults a]
res
      EvalResults a -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a. Monad m => a -> m a
return EvalResults a
evalVector

    Stats StatsDef a
def -- alter experiment and restart evaluation
      | Bool -> (Over a -> Bool) -> Maybe (Over a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Over a -> Over a -> Bool
forall a. Ord a => a -> a -> Bool
> Over a
forall a. Over a
OverPeriods) (StatsDef a -> Maybe (Over a)
forall a. StatsDef a -> Maybe (Over a)
getOver StatsDef a
def) -> do
        String -> DB (ExpM a) (EvalResults a)
forall a. HasCallStack => String -> a
error String
"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 -> Experiment a
-> StatsDef a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 -> Of a -> EvalResults a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval (EvalResults a -> EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (EvalResults a -> EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 ReaderT
  SqlBackend
  (LoggingT (ResourceT (ExpM a)))
  (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 -> Of a -> EvalResults a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval (EvalResults a -> EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (EvalResults a -> EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 ReaderT
  SqlBackend
  (LoggingT (ResourceT (ExpM a)))
  (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 -> Of a -> EvalResults a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval (EvalResults a -> EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (EvalResults a -> EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 ReaderT
  SqlBackend
  (LoggingT (ResourceT (ExpM a)))
  (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 -> Of a -> EvalResults a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a -> EvalResults a
reduceBinaryOf Of a
eval (EvalResults a -> EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (EvalResults a -> EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 ReaderT
  SqlBackend
  (LoggingT (ResourceT (ExpM a)))
  (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 <- ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
-> DB (ExpM a) (Maybe (EvalResults a))
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
 -> DB (ExpM a) (Maybe (EvalResults a)))
-> ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
-> DB (ExpM a) (Maybe (EvalResults a))
forall a b. (a -> b) -> a -> b
$ AvailabilityListWhere
-> AvailabilityList (ExpM a) Measure
-> ConduitT () Measure (DB (ExpM a)) ()
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 ResultData a
-> Getting
     (AvailabilityList (ExpM a) Measure)
     (ResultData a)
     (AvailabilityList (ExpM a) Measure)
-> AvailabilityList (ExpM a) Measure
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) ConduitT () Measure (DB (ExpM a)) ()
-> ConduitM Measure Void (DB (ExpM a)) (Maybe (EvalResults a))
-> ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Measure -> EvalResults a)
-> ConduitT Measure (EvalResults a) (DB (ExpM a)) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (Text -> Measure -> EvalResults a
forall a. Text -> Measure -> EvalResults a
fromMeasure (Text -> Measure -> EvalResults a)
-> Text -> Measure -> EvalResults a
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) ConduitT Measure (EvalResults a) (DB (ExpM a)) ()
-> ConduitM
     (EvalResults a) Void (DB (ExpM a)) (Maybe (EvalResults a))
-> ConduitM Measure Void (DB (ExpM a)) (Maybe (EvalResults a))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (EvalResults a) Void (DB (ExpM a)) (Maybe (EvalResults a))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
headC
      EvalResults a -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResults a -> DB (ExpM a) (EvalResults a))
-> EvalResults a -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$ StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ Of a -> Of a
forall a. Of a -> Of a
First (Of a -> Of a) -> Of a -> Of a
forall a b. (a -> b) -> a -> b
$ StatsDef a -> Of a
forall a. StatsDef a -> Of a
Stats (StatsDef a -> Of a) -> StatsDef a -> Of a
forall a b. (a -> b) -> a -> b
$ Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ ByteString -> Of a
forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitPeriods [EvalResults a -> Maybe (EvalResults a) -> EvalResults a
forall a. a -> Maybe a -> a
fromMaybe (String -> EvalResults a
forall a. HasCallStack => String -> a
error (String -> EvalResults a) -> String -> EvalResults a
forall a b. (a -> b) -> a -> b
$ String
"empty elements in evalOf First(Of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")") Maybe (EvalResults a)
res]
    First Of a
eval' -> Of a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 <- ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
-> DB (ExpM a) (Maybe (EvalResults a))
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
 -> DB (ExpM a) (Maybe (EvalResults a)))
-> ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
-> DB (ExpM a) (Maybe (EvalResults a))
forall a b. (a -> b) -> a -> b
$ AvailabilityListWhere
-> AvailabilityList (ExpM a) Measure
-> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *) a.
AvailabilityListWhere
-> AvailabilityList m a -> ConduitT () a (DB m) ()
srcAvailableListWhere (ByteString -> AvailabilityListWhere
whereName ByteString
name) (ResultData a
resData ResultData a
-> Getting
     (AvailabilityList (ExpM a) Measure)
     (ResultData a)
     (AvailabilityList (ExpM a) Measure)
-> AvailabilityList (ExpM a) Measure
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) ConduitT () Measure (DB (ExpM a)) ()
-> ConduitM Measure Void (DB (ExpM a)) (Maybe (EvalResults a))
-> ConduitT () Void (DB (ExpM a)) (Maybe (EvalResults a))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Measure -> EvalResults a)
-> ConduitT Measure (EvalResults a) (DB (ExpM a)) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (Text -> Measure -> EvalResults a
forall a. Text -> Measure -> EvalResults a
fromMeasure (Text -> Measure -> EvalResults a)
-> Text -> Measure -> EvalResults a
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) ConduitT Measure (EvalResults a) (DB (ExpM a)) ()
-> ConduitM
     (EvalResults a) Void (DB (ExpM a)) (Maybe (EvalResults a))
-> ConduitM Measure Void (DB (ExpM a)) (Maybe (EvalResults a))
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (EvalResults a) Void (DB (ExpM a)) (Maybe (EvalResults a))
forall (m :: * -> *) a o. Monad m => ConduitT a o m (Maybe a)
lastC
      EvalResults a -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResults a -> DB (ExpM a) (EvalResults a))
-> EvalResults a -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$ StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
forall a. StatsDef a -> Unit -> [EvalResults a] -> EvalResults a
EvalVector (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ Of a -> Of a
forall a. Of a -> Of a
Last (Of a -> Of a) -> Of a -> Of a
forall a b. (a -> b) -> a -> b
$ StatsDef a -> Of a
forall a. StatsDef a -> Of a
Stats (StatsDef a -> Of a) -> StatsDef a -> Of a
forall a b. (a -> b) -> a -> b
$ Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ ByteString -> Of a
forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitPeriods [EvalResults a -> Maybe (EvalResults a) -> EvalResults a
forall a. a -> Maybe a -> a
fromMaybe (String -> EvalResults a
forall a. HasCallStack => String -> a
error (String -> EvalResults a) -> String -> EvalResults a
forall a b. (a -> b) -> a -> b
$ String
"empty elements in evalOf Last(Of " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ByteString -> String
forall a. Show a => a -> String
show ByteString
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")") Maybe (EvalResults a)
res]
    Last Of a
eval' -> Of a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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' -> Of a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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 <- ConduitT () Void (DB (ExpM a)) Double -> DB (ExpM a) Double
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (DB (ExpM a)) Double -> DB (ExpM a) Double)
-> ConduitT () Void (DB (ExpM a)) Double -> DB (ExpM a) Double
forall a b. (a -> b) -> a -> b
$ AvailabilityListWhere
-> AvailabilityList (ExpM a) Measure
-> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *) a.
AvailabilityListWhere
-> AvailabilityList m a -> ConduitT () a (DB m) ()
srcAvailableListWhere (ByteString -> AvailabilityListWhere
whereName ByteString
name) (ResultData a
resData ResultData a
-> Getting
     (AvailabilityList (ExpM a) Measure)
     (ResultData a)
     (AvailabilityList (ExpM a) Measure)
-> AvailabilityList (ExpM a) Measure
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) ConduitT () Measure (DB (ExpM a)) ()
-> ConduitM Measure Void (DB (ExpM a)) Double
-> ConduitT () Void (DB (ExpM a)) Double
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (Measure -> EvalResults Any)
-> ConduitT Measure (EvalResults Any) (DB (ExpM a)) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC (Text -> Measure -> EvalResults Any
forall a. Text -> Measure -> EvalResults a
fromMeasure (Text -> Measure -> EvalResults Any)
-> Text -> Measure -> EvalResults Any
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
E.decodeUtf8 ByteString
name) ConduitT Measure (EvalResults Any) (DB (ExpM a)) ()
-> ConduitM (EvalResults Any) Void (DB (ExpM a)) Double
-> ConduitM Measure Void (DB (ExpM a)) Double
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM (EvalResults Any) Void (DB (ExpM a)) Double
forall (m :: * -> *) len a o.
(Monad m, Num len) =>
ConduitT a o m len
lengthC
      EvalResults a -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a. Monad m => a -> m a
return (EvalResults a -> DB (ExpM a) (EvalResults a))
-> EvalResults a -> DB (ExpM a) (EvalResults a)
forall a b. (a -> b) -> a -> b
$ StatsDef a -> Unit -> Double -> EvalResults a
forall a. StatsDef a -> Unit -> Double -> EvalResults a
EvalReducedValue (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ Of a -> Of a
forall a. Of a -> Of a
Length (Of a -> Of a) -> Of a -> Of a
forall a b. (a -> b) -> a -> b
$ StatsDef a -> Of a
forall a. StatsDef a -> Of a
Stats (StatsDef a -> Of a) -> StatsDef a -> Of a
forall a b. (a -> b) -> a -> b
$ Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ ByteString -> Of a
forall a. ByteString -> Of a
Of ByteString
name) Unit
UnitScalar Double
res
    Length Of a
eval' -> Of a -> EvalResults a -> EvalResults a
forall a. Of a -> EvalResults a -> EvalResults a
reduceUnaryOf Of a
eval (EvalResults a -> EvalResults a)
-> DB (ExpM a) (EvalResults a) -> DB (ExpM a) (EvalResults a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Experiment a -> Of a -> ResultData a -> DB (ExpM a) (EvalResults a)
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' (() -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    whereName' :: SqlQuery () -> ByteString -> AvailabilityListWhere
whereName' SqlQuery ()
add ByteString
name =
      case ResultData a
resData ResultData a
-> Getting ResultDataKey (ResultData a) ResultDataKey
-> ResultDataKey
forall s a. s -> Getting a s a -> a
^. Getting ResultDataKey (ResultData a) ResultDataKey
forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep Key PrepResultData
_ -> (SqlExpr (Entity PrepMeasure)
 -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
PrepMeasureWhere ((SqlExpr (Entity PrepMeasure)
  -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
 -> AvailabilityListWhere)
-> (SqlExpr (Entity PrepMeasure)
    -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity PrepMeasure)
_ SqlExpr (Entity PrepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepResultStep)
resStep SqlExpr (Entity PrepResultStep)
-> EntityField PrepResultStep Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepResultStep Text
forall typ. (typ ~ Text) => EntityField PrepResultStep typ
PrepResultStepName SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name)) SqlQuery () -> SqlQuery () -> SqlQuery ()
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 ((SqlExpr (Entity WarmUpMeasure)
  -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
 -> AvailabilityListWhere)
-> (SqlExpr (Entity WarmUpMeasure)
    -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
-> AvailabilityListWhere
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity WarmUpMeasure)
_ SqlExpr (Entity WarmUpResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpResultStep)
resStep SqlExpr (Entity WarmUpResultStep)
-> EntityField WarmUpResultStep Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpResultStep Text
forall typ. (typ ~ Text) => EntityField WarmUpResultStep typ
WarmUpResultStepName SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name)) SqlQuery () -> SqlQuery () -> SqlQuery ()
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 ((SqlExpr (Entity RepMeasure)
  -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
 -> AvailabilityListWhere)
-> (SqlExpr (Entity RepMeasure)
    -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity RepMeasure)
_ SqlExpr (Entity RepResultStep)
resStep -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepResultStep)
resStep SqlExpr (Entity RepResultStep)
-> EntityField RepResultStep Text -> SqlExpr (Value Text)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepResultStep Text
forall typ. (typ ~ Text) => EntityField RepResultStep typ
RepResultStepName SqlExpr (Value Text)
-> SqlExpr (Value Text) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Text -> SqlExpr (Value Text)
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val (ByteString -> Text
E.decodeUtf8 ByteString
name)) SqlQuery () -> SqlQuery () -> SqlQuery ()
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 :: Text -> Measure -> EvalResults a
fromMeasure Text
name (Measure Int
p [StepResult]
res) = case (StepResult -> Bool) -> [StepResult] -> Maybe StepResult
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
name) (Text -> Bool) -> (StepResult -> Text) -> StepResult -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Text StepResult Text -> StepResult -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text StepResult Text
Lens' StepResult Text
resultName) [StepResult]
res of
  Maybe StepResult
Nothing -> String -> EvalResults a
forall a. HasCallStack => String -> a
error (String -> EvalResults a) -> String -> EvalResults a
forall a b. (a -> b) -> a -> b
$ String
"Variable with name " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" could not be found!"
  Just (StepResult Text
n Maybe Double
mX Double
y) -> StatsDef a
-> Unit
-> ByteString
-> Either Int Double
-> Double
-> EvalResults a
forall a.
StatsDef a
-> Unit
-> ByteString
-> Either Int Double
-> Double
-> EvalResults a
EvalValue (Of a -> StatsDef a
forall a. Of a -> StatsDef a
Id (Of a -> StatsDef a) -> Of a -> StatsDef a
forall a b. (a -> b) -> a -> b
$ ByteString -> Of a
forall a. ByteString -> Of a
Of (ByteString -> Of a) -> ByteString -> Of a
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
E.encodeUtf8 Text
n) Unit
UnitPeriods (Text -> ByteString
E.encodeUtf8 Text
n) (Either Int Double
-> (Double -> Either Int Double)
-> Maybe Double
-> Either Int Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int -> Either Int Double
forall a b. a -> Either a b
Left Int
p) Double -> Either Int Double
forall a b. b -> Either a b
Right Maybe Double
mX) Double
y