{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict              #-}
{-# LANGUAGE TemplateHaskell     #-}
{-# LANGUAGE TypeFamilies        #-}
module Experimenter.Result.Query
    ( loadExperiments
    , loadExperimentResults
    , loadExperimentsResults
    , loadPreparationInputWhere
    , loadPreparationMeasuresWhere
    , loadPreparationAggregateWhere
    , loadReplicationWarmUpInputWhere
    , loadReplicationWarmUpMeasuresWhere
    , loadReplicationWarmUpAggregateWhere
    , loadReplicationInputWhere
    , loadReplicationMeasuresWhere
    , loadReparationAggregateWhere
    , loadResDataEndState
    , loadResDataStartState
    , loadParamSetup
    , deserialise
    , mDeserialise
    , setParams
    , fromRandGen
    , toRandGen
    , serialiseSeed
    , deserialiseSeed
    , StartStateType (..)
    , EndStateType (..)
    , setResDataStartState
    , setResDataEndState
    ) where

import           Conduit                     as C
import           Control.DeepSeq
import           Control.Lens                (view)
import           Control.Monad.Logger
import           Control.Monad.Reader
import           Control.Monad.Trans.Maybe
import           Data.ByteString             (ByteString)
import qualified Data.ByteString             as B
import qualified Data.Conduit.List           as CL
import           Data.Either                 (isLeft)
import           Data.Function               (on)
import qualified Data.List                   as L
import           Data.Maybe                  (fromMaybe)
import           Data.Serialize              as S (Serialize, get, put, runGet, runPut)
import qualified Data.Text                   as T
import           Data.Time                   (getCurrentTime)
import           Data.Vector.Serialize       ()
import qualified Data.Vector.Unboxed         as V
import           Data.Word                   (Word32)
import qualified Database.Esqueleto          as E
import           Database.Persist            as P
import           Database.Persist.Postgresql (SqlBackend)
import           Database.Persist.Sql        (transactionSave)
import           Prelude                     hiding (exp)
import           System.Random.MWC

import           Experimenter.Availability
import           Experimenter.DB
import           Experimenter.Experiment
import           Experimenter.Input
import           Experimenter.Measure
import           Experimenter.Models
import           Experimenter.Parameter
import           Experimenter.Result.Type
import           Experimenter.Setting
import           Experimenter.StepResult
import           Experimenter.Util


data EndStateType
  = EndStatePrep !(Key PrepResultData)
  | EndStateWarmUp !(Key WarmUpResultData)
  | EndStateRep !(Key RepResultData)


data StartStateType
  = StartStatePrep !(Key PrepResultData)
  | StartStateWarmUp !(Key WarmUpResultData)
  | StartStateRep !(Key RepResultData)


loadExperimentsResults :: (ExperimentDef a) => ExperimentSetting -> InputState a -> a -> Key Exps -> DB (ExpM a) (Maybe (Experiments a))
loadExperimentsResults :: ExperimentSetting
-> InputState a
-> a
-> Key Exps
-> DB (ExpM a) (Maybe (Experiments a))
loadExperimentsResults ExperimentSetting
setup InputState a
initInpSt a
initSt Key Exps
key =
  MaybeT
  (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
  (Experiments a)
-> DB (ExpM a) (Maybe (Experiments a))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
   (Experiments a)
 -> DB (ExpM a) (Maybe (Experiments a)))
-> MaybeT
     (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
     (Experiments a)
-> DB (ExpM a) (Maybe (Experiments a))
forall a b. (a -> b) -> a -> b
$ do
    Exps
e <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe Exps)
-> MaybeT (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a)))) Exps
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe Exps)
 -> MaybeT
      (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a)))) Exps)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe Exps)
-> MaybeT (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a)))) Exps
forall a b. (a -> b) -> a -> b
$ Key Exps
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe Exps)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
P.get Key Exps
key
    [Experiment a]
exps <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
-> MaybeT
     (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a)))) [Experiment a]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Experiment a -> Experiment a -> Ordering)
-> [Experiment a] -> [Experiment a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Experiment a -> Int)
-> Experiment a
-> Experiment a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Int (Experiment a) Int -> Experiment a -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (Experiment a) Int
forall a. Lens' (Experiment a) Int
experimentNumber) ([Experiment a] -> [Experiment a])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key Exps
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
forall a. ExperimentDef a => Key Exps -> DB (ExpM a) [Experiment a]
loadExperimentList Key Exps
key)
    [ExpsInfoParam]
expInfoParams <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ExpsInfoParam]
-> MaybeT
     (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
     [ExpsInfoParam]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Entity ExpsInfoParam -> ExpsInfoParam)
-> [Entity ExpsInfoParam] -> [ExpsInfoParam]
forall a b. (a -> b) -> [a] -> [b]
map Entity ExpsInfoParam -> ExpsInfoParam
forall record. Entity record -> record
entityVal ([Entity ExpsInfoParam] -> [ExpsInfoParam])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity ExpsInfoParam]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExpsInfoParam]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter ExpsInfoParam]
-> [SelectOpt ExpsInfoParam]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity ExpsInfoParam]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField ExpsInfoParam (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField ExpsInfoParam typ
ExpsInfoParamExps EntityField ExpsInfoParam (Key Exps)
-> Key Exps -> Filter ExpsInfoParam
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exps
key] [])
    Entity ExpsSetup
eSetup <- ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpsSetup)
-> MaybeT
     (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
     (Entity ExpsSetup)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Entity ExpsSetup -> Maybe (Entity ExpsSetup) -> Entity ExpsSetup
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Entity ExpsSetup
forall a. HasCallStack => [Char] -> a
error [Char]
"Setup not found. Your DB is corrupted!") (Maybe (Entity ExpsSetup) -> Entity ExpsSetup)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity ExpsSetup))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpsSetup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unique ExpsSetup
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity ExpsSetup))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy (Key Exps -> Unique ExpsSetup
UniqueExpsSetup Key Exps
key))
    [[ExperimentInfoParameter]]
infoParms <- ReaderT
  SqlBackend
  (LoggingT (ResourceT (ExpM a)))
  [[ExperimentInfoParameter]]
-> MaybeT
     (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
     [[ExperimentInfoParameter]]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((ExpsInfoParam
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      [ExperimentInfoParameter])
-> [ExpsInfoParam]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [[ExperimentInfoParameter]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ExpsInfoParam
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [ExperimentInfoParameter]
fromInfoParam [ExpsInfoParam]
expInfoParams)
    Experiments a
-> MaybeT
     (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
     (Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Experiments a
 -> MaybeT
      (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
      (Experiments a))
-> Experiments a
-> MaybeT
     (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))))
     (Experiments a)
forall a b. (a -> b) -> a -> b
$
      Key Exps
-> Text
-> UTCTime
-> Maybe UTCTime
-> ExpsSetup
-> [ParameterSetup a]
-> [ExperimentInfoParameter]
-> a
-> InputState a
-> [Experiment a]
-> Experiments a
forall a.
Key Exps
-> Text
-> UTCTime
-> Maybe UTCTime
-> ExpsSetup
-> [ParameterSetup a]
-> [ExperimentInfoParameter]
-> a
-> InputState a
-> [Experiment a]
-> Experiments a
Experiments
        Key Exps
key
        (Getting Text Exps Text -> Exps -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Exps Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Exps -> f Exps
expsName Exps
e)
        (Getting UTCTime Exps UTCTime -> Exps -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime Exps UTCTime
forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> Exps -> f Exps
expsStartTime Exps
e)
        (Getting (Maybe UTCTime) Exps (Maybe UTCTime)
-> Exps -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) Exps (Maybe UTCTime)
forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime)) -> Exps -> f Exps
expsEndTime Exps
e)
        (Entity ExpsSetup -> ExpsSetup
forall record. Entity record -> record
entityVal Entity ExpsSetup
eSetup)
        (a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
initSt)
        ([[ExperimentInfoParameter]] -> [ExperimentInfoParameter]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ExperimentInfoParameter]]
infoParms)
        a
initSt
        InputState a
initInpSt
        [Experiment a]
exps
  where
    infoParams :: [ExperimentInfoParameter]
infoParams = Getting
  [ExperimentInfoParameter]
  ExperimentSetting
  [ExperimentInfoParameter]
-> ExperimentSetting -> [ExperimentInfoParameter]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [ExperimentInfoParameter]
  ExperimentSetting
  [ExperimentInfoParameter]
Lens' ExperimentSetting [ExperimentInfoParameter]
experimentInfoParameters ExperimentSetting
setup
    fromInfoParam :: ExpsInfoParam
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [ExperimentInfoParameter]
fromInfoParam (ExpsInfoParam Key Exps
_ Text
n ByteString
bs) =
      case (ExperimentInfoParameter -> Bool)
-> [ExperimentInfoParameter] -> Maybe ExperimentInfoParameter
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) (Text -> Bool)
-> (ExperimentInfoParameter -> Text)
-> ExperimentInfoParameter
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExperimentInfoParameter -> Text
infoParameterName) [ExperimentInfoParameter]
infoParams of
        Maybe ExperimentInfoParameter
Nothing -> do
          $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not find parameter " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in settings while loading values from the DB. It will not be reported therefore!"
          [ExperimentInfoParameter]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [ExperimentInfoParameter]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just (ExperimentInfoParameter Text
_ b
v) -> [ExperimentInfoParameter]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [ExperimentInfoParameter]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text -> b -> ExperimentInfoParameter
forall b.
(Show b, Eq b, Serialize b) =>
Text -> b -> ExperimentInfoParameter
ExperimentInfoParameter Text
n (b -> Either [Char] b -> b
forall p a. p -> Either a p -> p
fromEitherDef b
v (Either [Char] b -> b) -> Either [Char] b -> b
forall a b. (a -> b) -> a -> b
$ Get b -> ByteString -> Either [Char] b
forall a. Get a -> ByteString -> Either [Char] a
S.runGet Get b
forall t. Serialize t => Get t
S.get ByteString
bs)]
    fromEitherDef :: p -> Either a p -> p
fromEitherDef p
_ (Right p
x) = p
x
    fromEitherDef p
d (Left a
_)  = p
d


loadExperiments :: (ExperimentDef a) => ExperimentSetting -> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments :: ExperimentSetting
-> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments ExperimentSetting
setup InputState a
initInpSt a
initSt = do
  Entity Exps
eExp <- ExperimentSetting
-> InputState a
-> a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity Exps)
forall a.
ExperimentDef a =>
ExperimentSetting -> InputState a -> a -> DB (ExpM a) (Entity Exps)
getOrCreateExps ExperimentSetting
setup InputState a
initInpSt a
initSt
  let e :: Exps
e = Entity Exps -> Exps
forall record. Entity record -> record
entityVal Entity Exps
eExp
  [Experiment a]
exps <- (Experiment a -> Experiment a -> Ordering)
-> [Experiment a] -> [Experiment a]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Experiment a -> Int)
-> Experiment a
-> Experiment a
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Int (Experiment a) Int -> Experiment a -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (Experiment a) Int
forall a. Lens' (Experiment a) Int
experimentNumber) ([Experiment a] -> [Experiment a])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key Exps
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
forall a. ExperimentDef a => Key Exps -> DB (ExpM a) [Experiment a]
loadExperimentList (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp)
  Entity ExpsSetup
eSetup <- Entity ExpsSetup -> Maybe (Entity ExpsSetup) -> Entity ExpsSetup
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Entity ExpsSetup
forall a. HasCallStack => [Char] -> a
error [Char]
"Setup not found. Your DB is corrupted!") (Maybe (Entity ExpsSetup) -> Entity ExpsSetup)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity ExpsSetup))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpsSetup)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unique ExpsSetup
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity ExpsSetup))
forall backend record (m :: * -> *).
(PersistUniqueRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record -> ReaderT backend m (Maybe (Entity record))
getBy (Key Exps -> Unique ExpsSetup
UniqueExpsSetup (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp))
  Experiments a -> DB (ExpM a) (Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Experiments a -> DB (ExpM a) (Experiments a))
-> Experiments a -> DB (ExpM a) (Experiments a)
forall a b. NFData a => (a -> b) -> a -> b
$!!
    Key Exps
-> Text
-> UTCTime
-> Maybe UTCTime
-> ExpsSetup
-> [ParameterSetup a]
-> [ExperimentInfoParameter]
-> a
-> InputState a
-> [Experiment a]
-> Experiments a
forall a.
Key Exps
-> Text
-> UTCTime
-> Maybe UTCTime
-> ExpsSetup
-> [ParameterSetup a]
-> [ExperimentInfoParameter]
-> a
-> InputState a
-> [Experiment a]
-> Experiments a
Experiments
      (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp)
      (Getting Text Exps Text -> Exps -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text Exps Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Exps -> f Exps
expsName Exps
e)
      (Getting UTCTime Exps UTCTime -> Exps -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime Exps UTCTime
forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> Exps -> f Exps
expsStartTime Exps
e)
      (Getting (Maybe UTCTime) Exps (Maybe UTCTime)
-> Exps -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) Exps (Maybe UTCTime)
forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime)) -> Exps -> f Exps
expsEndTime Exps
e)
      (Entity ExpsSetup -> ExpsSetup
forall record. Entity record -> record
entityVal Entity ExpsSetup
eSetup)
      (a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
initSt)
      (Getting
  [ExperimentInfoParameter]
  ExperimentSetting
  [ExperimentInfoParameter]
-> ExperimentSetting -> [ExperimentInfoParameter]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [ExperimentInfoParameter]
  ExperimentSetting
  [ExperimentInfoParameter]
Lens' ExperimentSetting [ExperimentInfoParameter]
experimentInfoParameters ExperimentSetting
setup)
      a
initSt
      InputState a
initInpSt
      [Experiment a]
exps


loadExperimentList :: (ExperimentDef a) => Key Exps -> DB (ExpM a) [Experiment a]
loadExperimentList :: Key Exps -> DB (ExpM a) [Experiment a]
loadExperimentList Key Exps
expsKey = [Filter Exp]
-> [SelectOpt Exp]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity Exp]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField Exp (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField Exp typ
ExpExps EntityField Exp (Key Exps) -> Key Exps -> Filter Exp
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exps
expsKey] [] ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity Exp]
-> ([Entity Exp] -> DB (ExpM a) [Experiment a])
-> DB (ExpM a) [Experiment a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Entity Exp
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiment a))
-> [Entity Exp] -> DB (ExpM a) [Experiment a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Entity Exp
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiment a)
forall a.
ExperimentDef a =>
Entity Exp
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiment a)
mkExperiment
    where mkExperiment :: Entity Exp
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiment a)
mkExperiment (Entity Key Exp
k Exp
exp) = do
            [ParameterSetting a]
paramSetting <- Key Exp
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ParameterSetting a]
forall (m :: * -> *) a1.
MonadIO m =>
Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup Key Exp
k
            Key Exp
-> Int
-> UTCTime
-> Maybe UTCTime
-> [ParameterSetting a]
-> [ExperimentResult a]
-> Experiment a
forall a.
Key Exp
-> Int
-> UTCTime
-> Maybe UTCTime
-> [ParameterSetting a]
-> [ExperimentResult a]
-> Experiment a
Experiment Key Exp
k (Getting Int Exp Int -> Exp -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Exp Int
forall (f :: * -> *). Functor f => (Int -> f Int) -> Exp -> f Exp
expNumber Exp
exp) (Getting UTCTime Exp UTCTime -> Exp -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime Exp UTCTime
forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> Exp -> f Exp
expStartTime Exp
exp) (Getting (Maybe UTCTime) Exp (Maybe UTCTime) -> Exp -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) Exp (Maybe UTCTime)
forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime)) -> Exp -> f Exp
expEndTime Exp
exp) [ParameterSetting a]
paramSetting ([ExperimentResult a] -> Experiment a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiment a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key Exp
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
forall a.
ExperimentDef a =>
Key Exp -> DB (ExpM a) [ExperimentResult a]
loadExperimentResults Key Exp
k


mDeserialise :: (MonadIO m, MonadLogger m ,Serialize a) => T.Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise :: Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise Text
n Maybe ByteString
mBs = Maybe (m (Maybe a)) -> m (Maybe (Maybe a))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Text -> ByteString -> m (Maybe a)
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
n (ByteString -> m (Maybe a))
-> Maybe ByteString -> Maybe (m (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
mBs)


deserialise :: (MonadIO m, MonadLogger m, Serialize a) => T.Text -> ByteString -> m (Maybe a)
deserialise :: Text -> ByteString -> m (Maybe a)
deserialise Text
n ByteString
bs =
  let !res :: Either [Char] a
res = Get a -> ByteString -> Either [Char] a
forall a. Get a -> ByteString -> Either [Char] a
runGet Get a
forall t. Serialize t => Get t
S.get ByteString
bs
   in case Either [Char] a
res of
        Left [Char]
err -> do
          $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logError) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not deserialise " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"! Discarding saved experiment result. Data length: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (ByteString -> Int
B.length ByteString
bs) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Error Message: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. Show a => a -> Text
tshow [Char]
err
          Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        Right a
r -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$! a -> Maybe a
forall a. a -> Maybe a
Just a
r


loadExperimentResults :: (ExperimentDef a) => Key Exp -> DB (ExpM a) [ExperimentResult a]
loadExperimentResults :: Key Exp -> DB (ExpM a) [ExperimentResult a]
loadExperimentResults Key Exp
kExp = do
  [Entity ExpResult]
xs <- [Filter ExpResult]
-> [SelectOpt ExpResult]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity ExpResult]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField ExpResult (Key Exp)
forall typ. (typ ~ Key Exp) => EntityField ExpResult typ
ExpResultExp EntityField ExpResult (Key Exp) -> Key Exp -> Filter ExpResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exp
kExp] [EntityField ExpResult Int -> SelectOpt ExpResult
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField ExpResult Int
forall typ. (typ ~ Int) => EntityField ExpResult typ
ExpResultRepetition]
  (Entity ExpResult
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentResult a))
-> [Entity ExpResult] -> DB (ExpM a) [ExperimentResult a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Entity ExpResult
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ExperimentResult a)
forall a.
ExperimentDef a =>
Entity ExpResult -> DB (ExpM a) (ExperimentResult a)
loadExperimentResult [Entity ExpResult]
xs


loadResDataEndState ::
     forall a. (ExperimentDef a)
  => Key Exp
  -> EndStateType
  -> DB (ExpM a) (Maybe a)
loadResDataEndState :: Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId EndStateType
endSt = do
  ![ByteString]
parts <-
    ([ByteString] -> [ByteString])
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> [ByteString]
forall a. NFData a => a -> a
force (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString])
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall a b. (a -> b) -> a -> b
$!
    case EndStateType
endSt of
      EndStatePrep Key PrepResultData
k -> (Entity PrepEndStatePart -> ByteString)
-> [Entity PrepEndStatePart] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ByteString PrepEndStatePart ByteString
-> PrepEndStatePart -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString PrepEndStatePart ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> PrepEndStatePart -> f PrepEndStatePart
prepEndStatePartData (PrepEndStatePart -> ByteString)
-> (Entity PrepEndStatePart -> PrepEndStatePart)
-> Entity PrepEndStatePart
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity PrepEndStatePart -> PrepEndStatePart
forall record. Entity record -> record
entityVal) ([Entity PrepEndStatePart] -> [ByteString])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity PrepEndStatePart]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter PrepEndStatePart]
-> [SelectOpt PrepEndStatePart]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity PrepEndStatePart]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField PrepEndStatePart (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepEndStatePart typ
PrepEndStatePartResultData EntityField PrepEndStatePart (Key PrepResultData)
-> Key PrepResultData -> Filter PrepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k] [EntityField PrepEndStatePart Int -> SelectOpt PrepEndStatePart
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField PrepEndStatePart Int
forall typ. (typ ~ Int) => EntityField PrepEndStatePart typ
PrepEndStatePartNumber]
      EndStateWarmUp Key WarmUpResultData
k -> (Entity WarmUpEndStatePart -> ByteString)
-> [Entity WarmUpEndStatePart] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ByteString WarmUpEndStatePart ByteString
-> WarmUpEndStatePart -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString WarmUpEndStatePart ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpEndStatePart -> f WarmUpEndStatePart
warmUpEndStatePartData (WarmUpEndStatePart -> ByteString)
-> (Entity WarmUpEndStatePart -> WarmUpEndStatePart)
-> Entity WarmUpEndStatePart
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity WarmUpEndStatePart -> WarmUpEndStatePart
forall record. Entity record -> record
entityVal) ([Entity WarmUpEndStatePart] -> [ByteString])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity WarmUpEndStatePart]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter WarmUpEndStatePart]
-> [SelectOpt WarmUpEndStatePart]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity WarmUpEndStatePart]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField WarmUpEndStatePart (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartResultData EntityField WarmUpEndStatePart (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k] [EntityField WarmUpEndStatePart Int -> SelectOpt WarmUpEndStatePart
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField WarmUpEndStatePart Int
forall typ. (typ ~ Int) => EntityField WarmUpEndStatePart typ
WarmUpEndStatePartNumber]
      EndStateRep Key RepResultData
k -> (Entity RepEndStatePart -> ByteString)
-> [Entity RepEndStatePart] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ByteString RepEndStatePart ByteString
-> RepEndStatePart -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString RepEndStatePart ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> RepEndStatePart -> f RepEndStatePart
repEndStatePartData (RepEndStatePart -> ByteString)
-> (Entity RepEndStatePart -> RepEndStatePart)
-> Entity RepEndStatePart
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity RepEndStatePart -> RepEndStatePart
forall record. Entity record -> record
entityVal) ([Entity RepEndStatePart] -> [ByteString])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity RepEndStatePart]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter RepEndStatePart]
-> [SelectOpt RepEndStatePart]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity RepEndStatePart]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField RepEndStatePart (Key RepResultData)
forall typ.
(typ ~ Key RepResultData) =>
EntityField RepEndStatePart typ
RepEndStatePartResultData EntityField RepEndStatePart (Key RepResultData)
-> Key RepResultData -> Filter RepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k] [EntityField RepEndStatePart Int -> SelectOpt RepEndStatePart
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField RepEndStatePart Int
forall typ. (typ ~ Int) => EntityField RepEndStatePart typ
RepEndStatePartNumber]
  !Maybe a
res <-
    if [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
parts
      then Maybe a -> DB (ExpM a) (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
      else do
        !Maybe (Serializable a)
mSer <- Text
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise ([Char] -> Text
T.pack [Char]
"end state") ([ByteString] -> ByteString
B.concat [ByteString]
parts)
        LoggingT (ResourceT (ExpM a)) (Maybe a) -> DB (ExpM a) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Maybe a) -> DB (ExpM a) (Maybe a))
-> LoggingT (ResourceT (ExpM a)) (Maybe a) -> DB (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$! ResourceT (ExpM a) (Maybe a)
-> LoggingT (ResourceT (ExpM a)) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Maybe a)
 -> LoggingT (ResourceT (ExpM a)) (Maybe a))
-> ResourceT (ExpM a) (Maybe a)
-> LoggingT (ResourceT (ExpM a)) (Maybe a)
forall a b. (a -> b) -> a -> b
$! ExpM a (Maybe a) -> ResourceT (ExpM a) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Maybe a) -> ResourceT (ExpM a) (Maybe a))
-> ExpM a (Maybe a) -> ResourceT (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$! ExpM a (Maybe a)
-> (Serializable a -> ExpM a (Maybe a))
-> Maybe (Serializable a)
-> ExpM a (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> ExpM a (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> ExpM a a -> ExpM a (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (ExpM a a -> ExpM a (Maybe a))
-> (Serializable a -> ExpM a a)
-> Serializable a
-> ExpM a (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serializable a -> ExpM a a
forall a. ExperimentDef a => Serializable a -> ExpM a a
deserialisable) Maybe (Serializable a)
mSer
  Maybe a -> Maybe a
forall a. NFData a => a -> a
force (Maybe a -> Maybe a)
-> DB (ExpM a) (Maybe a) -> DB (ExpM a) (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (a -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> Maybe a -> DB (ExpM a) (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Key Exp
-> a -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, ExperimentDef a) =>
Key Exp -> a -> ReaderT SqlBackend m a
setParams Key Exp
expId) Maybe a
res

loadResDataStartState :: (ExperimentDef a) => Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState :: Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId StartStateType
startSt = do
  ![ByteString]
parts <-
    ([ByteString] -> [ByteString])
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [ByteString] -> [ByteString]
forall a. NFData a => a -> a
force (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString])
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall a b. (a -> b) -> a -> b
$!
    case StartStateType
startSt of
      StartStatePrep Key PrepResultData
k -> (Entity PrepStartStatePart -> ByteString)
-> [Entity PrepStartStatePart] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ByteString PrepStartStatePart ByteString
-> PrepStartStatePart -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString PrepStartStatePart ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> PrepStartStatePart -> f PrepStartStatePart
prepStartStatePartData (PrepStartStatePart -> ByteString)
-> (Entity PrepStartStatePart -> PrepStartStatePart)
-> Entity PrepStartStatePart
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity PrepStartStatePart -> PrepStartStatePart
forall record. Entity record -> record
entityVal) ([Entity PrepStartStatePart] -> [ByteString])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity PrepStartStatePart]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter PrepStartStatePart]
-> [SelectOpt PrepStartStatePart]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity PrepStartStatePart]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField PrepStartStatePart (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepStartStatePart typ
PrepStartStatePartResultData EntityField PrepStartStatePart (Key PrepResultData)
-> Key PrepResultData -> Filter PrepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k] [EntityField PrepStartStatePart Int -> SelectOpt PrepStartStatePart
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField PrepStartStatePart Int
forall typ. (typ ~ Int) => EntityField PrepStartStatePart typ
PrepStartStatePartNumber]
      StartStateWarmUp Key WarmUpResultData
k -> (Entity WarmUpStartStatePart -> ByteString)
-> [Entity WarmUpStartStatePart] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ByteString WarmUpStartStatePart ByteString
-> WarmUpStartStatePart -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString WarmUpStartStatePart ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpStartStatePart -> f WarmUpStartStatePart
warmUpStartStatePartData (WarmUpStartStatePart -> ByteString)
-> (Entity WarmUpStartStatePart -> WarmUpStartStatePart)
-> Entity WarmUpStartStatePart
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity WarmUpStartStatePart -> WarmUpStartStatePart
forall record. Entity record -> record
entityVal) ([Entity WarmUpStartStatePart] -> [ByteString])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity WarmUpStartStatePart]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter WarmUpStartStatePart]
-> [SelectOpt WarmUpStartStatePart]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity WarmUpStartStatePart]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField WarmUpStartStatePart (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpStartStatePart typ
WarmUpStartStatePartResultData EntityField WarmUpStartStatePart (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k] [EntityField WarmUpStartStatePart Int
-> SelectOpt WarmUpStartStatePart
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField WarmUpStartStatePart Int
forall typ. (typ ~ Int) => EntityField WarmUpStartStatePart typ
WarmUpStartStatePartNumber]
      StartStateRep Key RepResultData
k -> (Entity RepStartStatePart -> ByteString)
-> [Entity RepStartStatePart] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ByteString RepStartStatePart ByteString
-> RepStartStatePart -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString RepStartStatePart ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> RepStartStatePart -> f RepStartStatePart
repStartStatePartData (RepStartStatePart -> ByteString)
-> (Entity RepStartStatePart -> RepStartStatePart)
-> Entity RepStartStatePart
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity RepStartStatePart -> RepStartStatePart
forall record. Entity record -> record
entityVal) ([Entity RepStartStatePart] -> [ByteString])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity RepStartStatePart]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter RepStartStatePart]
-> [SelectOpt RepStartStatePart]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [Entity RepStartStatePart]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField RepStartStatePart (Key RepResultData)
forall typ.
(typ ~ Key RepResultData) =>
EntityField RepStartStatePart typ
RepStartStatePartResultData EntityField RepStartStatePart (Key RepResultData)
-> Key RepResultData -> Filter RepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k] [EntityField RepStartStatePart Int -> SelectOpt RepStartStatePart
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField RepStartStatePart Int
forall typ. (typ ~ Int) => EntityField RepStartStatePart typ
RepStartStatePartNumber]
  !a
res <-
    if [ByteString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
parts
      then [Char] -> DB (ExpM a) a
forall a. HasCallStack => [Char] -> a
error [Char]
"Could not get start state"
      else do
        !Serializable a
ser <- Serializable a -> Maybe (Serializable a) -> Serializable a
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> Serializable a
forall a. HasCallStack => [Char] -> a
error [Char]
"Could not deserialise start state ") (Maybe (Serializable a) -> Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"prep start state" ([ByteString] -> ByteString
B.concat [ByteString]
parts)
        LoggingT (ResourceT (ExpM a)) a -> DB (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) a -> DB (ExpM a) a)
-> LoggingT (ResourceT (ExpM a)) a -> DB (ExpM a) a
forall a b. (a -> b) -> a -> b
$! ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a)
-> ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall a b. (a -> b) -> a -> b
$! ExpM a a -> ResourceT (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a a -> ResourceT (ExpM a) a)
-> ExpM a a -> ResourceT (ExpM a) a
forall a b. (a -> b) -> a -> b
$! Serializable a -> ExpM a a
forall a. ExperimentDef a => Serializable a -> ExpM a a
deserialisable Serializable a
ser
  a -> a
forall a. NFData a => a -> a
force (a -> a) -> DB (ExpM a) a -> DB (ExpM a) a
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> Key Exp -> a -> DB (ExpM a) a
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, ExperimentDef a) =>
Key Exp -> a -> ReaderT SqlBackend m a
setParams Key Exp
expId a
res


setResDataEndState :: (MonadIO m) => EndStateType -> Maybe ByteString -> ReaderT SqlBackend m ()
setResDataEndState :: EndStateType -> Maybe ByteString -> ReaderT SqlBackend m ()
setResDataEndState (EndStatePrep Key PrepResultData
k) (Just ByteString
bs) = do
  -- liftIO $ B.writeFile "/tmp/EndState" bs
  let parts :: [ByteString]
parts = ByteString -> [ByteString]
splitState ByteString
bs
  ((Int, ByteString)
 -> ReaderT SqlBackend m (Entity PrepEndStatePart))
-> [(Int, ByteString)] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> PrepEndStatePart
-> [Update PrepEndStatePart]
-> ReaderT SqlBackend m (Entity PrepEndStatePart)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key PrepResultData -> Int -> ByteString -> PrepEndStatePart
PrepEndStatePart Key PrepResultData
k Int
nr ByteString
part) [EntityField PrepEndStatePart ByteString
forall typ. (typ ~ ByteString) => EntityField PrepEndStatePart typ
PrepEndStatePartData EntityField PrepEndStatePart ByteString
-> ByteString -> Update PrepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) ([Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  [Filter PrepEndStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField PrepEndStatePart (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepEndStatePart typ
PrepEndStatePartResultData EntityField PrepEndStatePart (Key PrepResultData)
-> Key PrepResultData -> Filter PrepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k, EntityField PrepEndStatePart Int
forall typ. (typ ~ Int) => EntityField PrepEndStatePart typ
PrepEndStatePartNumber EntityField PrepEndStatePart Int -> Int -> Filter PrepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
parts]
setResDataEndState (EndStateWarmUp Key WarmUpResultData
k) (Just ByteString
bs) = do
  let parts :: [ByteString]
parts = ByteString -> [ByteString]
splitState ByteString
bs
  ((Int, ByteString)
 -> ReaderT SqlBackend m (Entity WarmUpEndStatePart))
-> [(Int, ByteString)] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> WarmUpEndStatePart
-> [Update WarmUpEndStatePart]
-> ReaderT SqlBackend m (Entity WarmUpEndStatePart)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key WarmUpResultData -> Int -> ByteString -> WarmUpEndStatePart
WarmUpEndStatePart Key WarmUpResultData
k Int
nr ByteString
part) [EntityField WarmUpEndStatePart ByteString
forall typ.
(typ ~ ByteString) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartData EntityField WarmUpEndStatePart ByteString
-> ByteString -> Update WarmUpEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) ([Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  [Filter WarmUpEndStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField WarmUpEndStatePart (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartResultData EntityField WarmUpEndStatePart (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k, EntityField WarmUpEndStatePart Int
forall typ. (typ ~ Int) => EntityField WarmUpEndStatePart typ
WarmUpEndStatePartNumber EntityField WarmUpEndStatePart Int
-> Int -> Filter WarmUpEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
parts]
setResDataEndState (EndStateRep Key RepResultData
k) (Just ByteString
bs) = do
  let parts :: [ByteString]
parts = ByteString -> [ByteString]
splitState ByteString
bs
  ((Int, ByteString)
 -> ReaderT SqlBackend m (Entity RepEndStatePart))
-> [(Int, ByteString)] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> RepEndStatePart
-> [Update RepEndStatePart]
-> ReaderT SqlBackend m (Entity RepEndStatePart)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key RepResultData -> Int -> ByteString -> RepEndStatePart
RepEndStatePart Key RepResultData
k Int
nr ByteString
part) [EntityField RepEndStatePart ByteString
forall typ. (typ ~ ByteString) => EntityField RepEndStatePart typ
RepEndStatePartData EntityField RepEndStatePart ByteString
-> ByteString -> Update RepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) ([Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  [Filter RepEndStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField RepEndStatePart (Key RepResultData)
forall typ.
(typ ~ Key RepResultData) =>
EntityField RepEndStatePart typ
RepEndStatePartResultData EntityField RepEndStatePart (Key RepResultData)
-> Key RepResultData -> Filter RepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k, EntityField RepEndStatePart Int
forall typ. (typ ~ Int) => EntityField RepEndStatePart typ
RepEndStatePartNumber EntityField RepEndStatePart Int -> Int -> Filter RepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
parts]
setResDataEndState (EndStatePrep Key PrepResultData
k) Maybe ByteString
Nothing = [Filter PrepEndStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField PrepEndStatePart (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepEndStatePart typ
PrepEndStatePartResultData EntityField PrepEndStatePart (Key PrepResultData)
-> Key PrepResultData -> Filter PrepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k]
setResDataEndState (EndStateWarmUp Key WarmUpResultData
k) Maybe ByteString
Nothing = [Filter WarmUpEndStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField WarmUpEndStatePart (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartResultData EntityField WarmUpEndStatePart (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k]
setResDataEndState (EndStateRep Key RepResultData
k) Maybe ByteString
Nothing = [Filter RepEndStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField RepEndStatePart (Key RepResultData)
forall typ.
(typ ~ Key RepResultData) =>
EntityField RepEndStatePart typ
RepEndStatePartResultData EntityField RepEndStatePart (Key RepResultData)
-> Key RepResultData -> Filter RepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k]


setResDataStartState :: (MonadIO m) => StartStateType -> ByteString -> ReaderT SqlBackend m ()
setResDataStartState :: StartStateType -> ByteString -> ReaderT SqlBackend m ()
setResDataStartState (StartStatePrep Key PrepResultData
k) ByteString
bs = do
  let parts :: [ByteString]
parts = ByteString -> [ByteString]
splitState ByteString
bs
  ((Int, ByteString)
 -> ReaderT SqlBackend m (Entity PrepStartStatePart))
-> [(Int, ByteString)] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> PrepStartStatePart
-> [Update PrepStartStatePart]
-> ReaderT SqlBackend m (Entity PrepStartStatePart)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key PrepResultData -> Int -> ByteString -> PrepStartStatePart
PrepStartStatePart Key PrepResultData
k Int
nr ByteString
part) [EntityField PrepStartStatePart ByteString
forall typ.
(typ ~ ByteString) =>
EntityField PrepStartStatePart typ
PrepStartStatePartData EntityField PrepStartStatePart ByteString
-> ByteString -> Update PrepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) ([Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  [Filter PrepStartStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField PrepStartStatePart (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepStartStatePart typ
PrepStartStatePartResultData EntityField PrepStartStatePart (Key PrepResultData)
-> Key PrepResultData -> Filter PrepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k, EntityField PrepStartStatePart Int
forall typ. (typ ~ Int) => EntityField PrepStartStatePart typ
PrepStartStatePartNumber EntityField PrepStartStatePart Int
-> Int -> Filter PrepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
parts]
setResDataStartState (StartStateWarmUp Key WarmUpResultData
k) ByteString
bs = do
  let parts :: [ByteString]
parts = ByteString -> [ByteString]
splitState ByteString
bs
  ((Int, ByteString)
 -> ReaderT SqlBackend m (Entity WarmUpStartStatePart))
-> [(Int, ByteString)] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> WarmUpStartStatePart
-> [Update WarmUpStartStatePart]
-> ReaderT SqlBackend m (Entity WarmUpStartStatePart)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key WarmUpResultData -> Int -> ByteString -> WarmUpStartStatePart
WarmUpStartStatePart Key WarmUpResultData
k Int
nr ByteString
part) [EntityField WarmUpStartStatePart ByteString
forall typ.
(typ ~ ByteString) =>
EntityField WarmUpStartStatePart typ
WarmUpStartStatePartData EntityField WarmUpStartStatePart ByteString
-> ByteString -> Update WarmUpStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) ([Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  [Filter WarmUpStartStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField WarmUpStartStatePart (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpStartStatePart typ
WarmUpStartStatePartResultData EntityField WarmUpStartStatePart (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k, EntityField WarmUpStartStatePart Int
forall typ. (typ ~ Int) => EntityField WarmUpStartStatePart typ
WarmUpStartStatePartNumber EntityField WarmUpStartStatePart Int
-> Int -> Filter WarmUpStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
parts]
setResDataStartState (StartStateRep Key RepResultData
k) ByteString
bs = do
  let parts :: [ByteString]
parts = ByteString -> [ByteString]
splitState ByteString
bs
  ((Int, ByteString)
 -> ReaderT SqlBackend m (Entity RepStartStatePart))
-> [(Int, ByteString)] -> ReaderT SqlBackend m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> RepStartStatePart
-> [Update RepStartStatePart]
-> ReaderT SqlBackend m (Entity RepStartStatePart)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key RepResultData -> Int -> ByteString -> RepStartStatePart
RepStartStatePart Key RepResultData
k Int
nr ByteString
part) [EntityField RepStartStatePart ByteString
forall typ. (typ ~ ByteString) => EntityField RepStartStatePart typ
RepStartStatePartData EntityField RepStartStatePart ByteString
-> ByteString -> Update RepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) ([Int] -> [ByteString] -> [(Int, ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  [Filter RepStartStatePart] -> ReaderT SqlBackend m ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField RepStartStatePart (Key RepResultData)
forall typ.
(typ ~ Key RepResultData) =>
EntityField RepStartStatePart typ
RepStartStatePartResultData EntityField RepStartStatePart (Key RepResultData)
-> Key RepResultData -> Filter RepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k, EntityField RepStartStatePart Int
forall typ. (typ ~ Int) => EntityField RepStartStatePart typ
RepStartStatePartNumber EntityField RepStartStatePart Int
-> Int -> Filter RepStartStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
parts]


splitState :: ByteString -> [ByteString]
splitState :: ByteString -> [ByteString]
splitState ByteString
bs
  | ByteString -> Bool
B.null ByteString
bs = []
  | Bool
otherwise = Int -> ByteString -> ByteString
B.take Int
splitLength ByteString
bs ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
splitState (Int -> ByteString -> ByteString
B.drop Int
splitLength ByteString
bs)
  where
    splitLength :: Int
splitLength = Int
128000000     -- 128MB as ByteString is composed of Word8 (8-bit unsigned integer = 1 byte) elements


setParams :: (MonadIO m, MonadLogger m, ExperimentDef a) => Key Exp -> a -> ReaderT SqlBackend m a
setParams :: Key Exp -> a -> ReaderT SqlBackend m a
setParams Key Exp
expId a
st = do
  [ParameterSetting Any]
paramSettings <- Key Exp -> ReaderT SqlBackend m [ParameterSetting Any]
forall (m :: * -> *) a1.
MonadIO m =>
Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup Key Exp
expId
  (a -> ParameterSetting Any -> ReaderT SqlBackend m a)
-> a -> [ParameterSetting Any] -> ReaderT SqlBackend m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM a -> ParameterSetting Any -> ReaderT SqlBackend m a
setParams' a
st [ParameterSetting Any]
paramSettings
  where setParams' :: a -> ParameterSetting Any -> ReaderT SqlBackend m a
setParams' !a
state !(ParameterSetting Text
n ByteString
bs Bool
_ ExperimentDesign
_) =
           case (ParameterSetup a -> Bool)
-> [ParameterSetup a] -> Maybe (ParameterSetup a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(ParameterSetup Text
name b -> a -> a
_ a -> b
_ Maybe (b -> IO [b])
_ Maybe (b, b)
_ Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_) -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) [ParameterSetup a]
paramSetup of
             Maybe (ParameterSetup a)
Nothing -> do
               $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ReaderT SqlBackend m ()
(Text -> ReaderT SqlBackend m ())
-> (Text -> Text) -> Text -> ReaderT SqlBackend m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logError) (Text -> ReaderT SqlBackend m ())
-> Text -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not find parameter with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the current parameter setting. Thus it cannot be modified!"
               a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
state
             Just (ParameterSetup Text
_ b -> a -> a
setter a -> b
_ Maybe (b -> IO [b])
_ Maybe (b, b)
_ Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_) ->
               case Get b -> ByteString -> Either [Char] b
forall a. Get a -> ByteString -> Either [Char] a
runGet Get b
forall t. Serialize t => Get t
S.get ByteString
bs of
                 Left [Char]
err -> [Char] -> ReaderT SqlBackend m a
forall a. HasCallStack => [Char] -> a
error ([Char] -> ReaderT SqlBackend m a)
-> [Char] -> ReaderT SqlBackend m a
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read value of parameter " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
n [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
". Aborting! Serializtion error was: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
err
                 Right b
val -> do
                   $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> ReaderT SqlBackend m ()
(Text -> ReaderT SqlBackend m ())
-> (Text -> Text) -> Text -> ReaderT SqlBackend m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend m ())
-> Text -> ReaderT SqlBackend m ()
forall a b. (a -> b) -> a -> b
$ Text
"Loaded parameter '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. Show a => a -> Text
tshow b
val
                   a -> ReaderT SqlBackend m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ReaderT SqlBackend m a) -> a -> ReaderT SqlBackend m a
forall a b. (a -> b) -> a -> b
$ b -> a -> a
setter b
val a
state
        paramSetup :: [ParameterSetup a]
paramSetup = a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
st

loadExperimentResult :: forall a . (ExperimentDef a) => Entity ExpResult -> DB (ExpM a) (ExperimentResult a)
loadExperimentResult :: Entity ExpResult -> DB (ExpM a) (ExperimentResult a)
loadExperimentResult (Entity Key ExpResult
k (ExpResult Key Exp
expId Int
rep Maybe (Key PrepResultData)
mPrepResDataId)) = do
  !Maybe (Entity PrepResultData)
mEPrepResData <- (Maybe (Maybe (Entity PrepResultData))
 -> Maybe (Entity PrepResultData))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity PrepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity PrepResultData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe (Entity PrepResultData))
-> Maybe (Entity PrepResultData)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ReaderT
   SqlBackend
   (LoggingT (ResourceT (ExpM a)))
   (Maybe (Maybe (Entity PrepResultData)))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity PrepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity PrepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity PrepResultData))
forall a b. (a -> b) -> a -> b
$ Maybe
  (ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity PrepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity PrepResultData)))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe
   (ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity PrepResultData)))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Maybe (Entity PrepResultData))))
-> Maybe
     (ReaderT
        SqlBackend
        (LoggingT (ResourceT (ExpM a)))
        (Maybe (Entity PrepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity PrepResultData)))
forall a b. (a -> b) -> a -> b
$ Key PrepResultData
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity PrepResultData))
forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
P.getEntity (Key PrepResultData
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity PrepResultData)))
-> Maybe (Key PrepResultData)
-> Maybe
     (ReaderT
        SqlBackend
        (LoggingT (ResourceT (ExpM a)))
        (Maybe (Entity PrepResultData)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Key PrepResultData)
mPrepResDataId
  !Maybe (ResultData a)
prepRes <-
    case Maybe (Entity PrepResultData)
mEPrepResData of
      Maybe (Entity PrepResultData)
Nothing -> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
forall a. Maybe a
Nothing
      Just (Entity Key PrepResultData
resDataKey (PrepResultData UTCTime
startT Maybe UTCTime
endT ByteString
startRandGenBS Maybe ByteString
endRandGenBS ByteString
startInpStBS Maybe ByteString
endInpStBS)) -> do
        let !startSt :: Availability (ExpM a) a
startSt = DB (ExpM a) a -> Availability (ExpM a) a
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (Key Exp -> StartStateType -> DB (ExpM a) a
forall a.
ExperimentDef a =>
Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId (Key PrepResultData -> StartStateType
StartStatePrep Key PrepResultData
resDataKey))
        let !endSt :: Availability (ExpM a) (Maybe a)
endSt = DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId (Key PrepResultData -> EndStateType
EndStatePrep Key PrepResultData
resDataKey))
        !Maybe (InputState a)
mStartInpSt <- Text
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (InputState a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"prep start input state" ByteString
startInpStBS
        !Maybe (Maybe (InputState a))
mEndInpSt <- Text
-> Maybe ByteString
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (InputState a)))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise Text
"prep end input state" Maybe ByteString
endInpStBS
        !Int
inpCount <- Key PrepResultData
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *).
MonadIO m =>
Key PrepResultData -> ReaderT SqlBackend m Int
loadPreparationInputCount Key PrepResultData
resDataKey
        !Int
resultCount <- Key PrepResultData
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *). MonadIO m => Key PrepResultData -> DB m Int
loadPrepartionMeasuresCount Key PrepResultData
resDataKey
        !Gen RealWorld
startRandG <- ByteString
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) GenIO
forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen ByteString
startRandGenBS
        !Maybe (Gen RealWorld)
endRandG <- ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
-> (ByteString
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld)))
-> Maybe ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Gen RealWorld)
forall a. Maybe a
Nothing) ((Gen RealWorld -> Maybe (Gen RealWorld))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Gen RealWorld -> Maybe (Gen RealWorld)
forall a. a -> Maybe a
Just (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld)))
-> (ByteString
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld))
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen) Maybe ByteString
endRandGenBS
        let !inputVals :: AvailabilityList (ExpM a) (Input a)
inputVals = (Int,
 AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) (Input a)
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
inpCount, Key PrepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ()
forall (m :: * -> *) a.
(MonadIO m, ExperimentDef a) =>
Key PrepResultData
-> AvailabilityListWhere -> ConduitM () (Input a) (DB m) ()
loadPreparationInputWhere Key PrepResultData
resDataKey)
        let !res :: AvailabilityList (ExpM a) Measure
res = (Int,
 AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) Measure
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
resultCount, Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *).
MonadIO m =>
Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadPreparationMeasuresWhere Key PrepResultData
resDataKey)
        Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ResultData a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a)))
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall a b. NFData a => (a -> b) -> a -> b
$!! ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
forall a.
ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
ResultData (Key PrepResultData -> ResultDataKey
ResultDataPrep Key PrepResultData
resDataKey) UTCTime
startT Maybe UTCTime
endT Gen RealWorld
GenIO
startRandG Maybe (Gen RealWorld)
Maybe GenIO
endRandG AvailabilityList (ExpM a) (Input a)
inputVals AvailabilityList (ExpM a) Measure
res Availability (ExpM a) a
startSt Availability (ExpM a) (Maybe a)
endSt (InputState a -> Maybe (InputState a) -> ResultData a)
-> Maybe (InputState a)
-> Maybe (Maybe (InputState a) -> ResultData a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
mStartInpSt Maybe (Maybe (InputState a) -> ResultData a)
-> Maybe (Maybe (InputState a)) -> Maybe (ResultData a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Maybe (InputState a))
mEndInpSt
  ![ReplicationResult a]
evalRes <- Key Exp
-> Key ExpResult
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ReplicationResult a]
forall a.
ExperimentDef a =>
Key Exp -> Key ExpResult -> DB (ExpM a) [ReplicationResult a]
loadReplicationResults Key Exp
expId Key ExpResult
k
  ExperimentResult a -> DB (ExpM a) (ExperimentResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExperimentResult a -> DB (ExpM a) (ExperimentResult a))
-> ExperimentResult a -> DB (ExpM a) (ExperimentResult a)
forall a b. NFData a => (a -> b) -> a -> b
$!! Key ExpResult
-> Int
-> Maybe (ResultData a)
-> [ReplicationResult a]
-> ExperimentResult a
forall a.
Key ExpResult
-> Int
-> Maybe (ResultData a)
-> [ReplicationResult a]
-> ExperimentResult a
ExperimentResult Key ExpResult
k Int
rep Maybe (ResultData a)
prepRes [ReplicationResult a]
evalRes


serialiseSeed :: Seed -> ByteString
serialiseSeed :: Seed -> ByteString
serialiseSeed Seed
seed = Put -> ByteString
S.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter (Vector Word32)
forall t. Serialize t => Putter t
S.put (Seed -> Vector Word32
fromSeed Seed
seed :: V.Vector Word32)

deserialiseSeed :: ByteString -> Seed
deserialiseSeed :: ByteString -> Seed
deserialiseSeed ByteString
bs = Vector Word32 -> Seed
forall (v :: * -> *). Vector v Word32 => v Word32 -> Seed
toSeed (Either [Char] (Vector Word32) -> Vector Word32
forall p. Either [Char] p -> p
fromRight (Either [Char] (Vector Word32) -> Vector Word32)
-> Either [Char] (Vector Word32) -> Vector Word32
forall a b. (a -> b) -> a -> b
$ Get (Vector Word32) -> ByteString -> Either [Char] (Vector Word32)
forall a. Get a -> ByteString -> Either [Char] a
S.runGet Get (Vector Word32)
forall t. Serialize t => Get t
S.get ByteString
bs :: V.Vector Word32)
  where fromRight :: Either [Char] p -> p
fromRight (Right p
s) = p
s
        fromRight (Left [Char]
err) = [Char] -> p
forall a. HasCallStack => [Char] -> a
error ([Char] -> p) -> [Char] -> p
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not deserialise random generator. Error Message: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
err

fromRandGen :: (MonadIO m) => GenIO -> m ByteString
fromRandGen :: GenIO -> m ByteString
fromRandGen GenIO
ran = do
  Vector Word32
vec <- IO (Vector Word32) -> m (Vector Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Seed -> Vector Word32
fromSeed (Seed -> Vector Word32) -> IO Seed -> IO (Vector Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenIO -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save GenIO
ran)
  ByteString -> m ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
S.runPut (Putter (Vector Word32)
forall t. Serialize t => Putter t
S.put Vector Word32
vec)


toRandGen :: (MonadIO m) => ByteString -> m GenIO
toRandGen :: ByteString -> m GenIO
toRandGen ByteString
bs =
  case Get (Vector Word32) -> ByteString -> Either [Char] (Vector Word32)
forall a. Get a -> ByteString -> Either [Char] a
S.runGet Get (Vector Word32)
forall t. Serialize t => Get t
S.get ByteString
bs of
    Left [Char]
err -> [Char] -> m (Gen RealWorld)
forall a. HasCallStack => [Char] -> a
error ([Char] -> m (Gen RealWorld)) -> [Char] -> m (Gen RealWorld)
forall a b. (a -> b) -> a -> b
$ [Char]
"Could not deserialise random generator. Error Message: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
err
    Right (Vector Word32
vec :: V.Vector Word32) -> IO (Gen RealWorld) -> m (Gen RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Seed -> IO GenIO
forall (m :: * -> *). PrimMonad m => Seed -> m (Gen (PrimState m))
restore (Seed -> IO GenIO) -> Seed -> IO GenIO
forall a b. (a -> b) -> a -> b
$ Vector Word32 -> Seed
forall (v :: * -> *). Vector v Word32 => v Word32 -> Seed
toSeed Vector Word32
vec)


loadParamSetup :: (MonadIO m) => Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup :: Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup Key Exp
kExp =
  (ParameterSetting a1 -> ParameterSetting a1 -> Ordering)
-> [ParameterSetting a1] -> [ParameterSetting a1]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (ParameterSetting a1 -> Text)
-> ParameterSetting a1
-> ParameterSetting a1
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Text (ParameterSetting a1) Text
-> ParameterSetting a1 -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (ParameterSetting a1) Text
forall a a2.
Lens (ParameterSetting a) (ParameterSetting a2) Text Text
parameterSettingName) ([ParameterSetting a1] -> [ParameterSetting a1])
-> ([Entity ParamSetting] -> [ParameterSetting a1])
-> [Entity ParamSetting]
-> [ParameterSetting a1]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity ParamSetting -> ParameterSetting a1)
-> [Entity ParamSetting] -> [ParameterSetting a1]
forall a b. (a -> b) -> [a] -> [b]
map (ParamSetting -> ParameterSetting a1
forall a. ParamSetting -> ParameterSetting a
mkParameterSetting' (ParamSetting -> ParameterSetting a1)
-> (Entity ParamSetting -> ParamSetting)
-> Entity ParamSetting
-> ParameterSetting a1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity ParamSetting -> ParamSetting
forall record. Entity record -> record
entityVal) ([Entity ParamSetting] -> [ParameterSetting a1])
-> ReaderT SqlBackend m [Entity ParamSetting]
-> ReaderT SqlBackend m [ParameterSetting a1]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  SqlQuery (SqlExpr (Entity ParamSetting))
-> SqlReadT m [Entity ParamSetting]
forall a r (m :: * -> *).
(SqlSelect a r, MonadIO m) =>
SqlQuery a -> SqlReadT m [r]
E.select ((SqlExpr (Entity ParamSetting)
 -> SqlQuery (SqlExpr (Entity ParamSetting)))
-> SqlQuery (SqlExpr (Entity ParamSetting))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from ((SqlExpr (Entity ParamSetting)
  -> SqlQuery (SqlExpr (Entity ParamSetting)))
 -> SqlQuery (SqlExpr (Entity ParamSetting)))
-> (SqlExpr (Entity ParamSetting)
    -> SqlQuery (SqlExpr (Entity ParamSetting)))
-> SqlQuery (SqlExpr (Entity ParamSetting))
forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity ParamSetting)
pm -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity ParamSetting)
pm SqlExpr (Entity ParamSetting)
-> EntityField ParamSetting (Key Exp) -> SqlExpr (Value (Key Exp))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField ParamSetting (Key Exp)
forall typ. (typ ~ Key Exp) => EntityField ParamSetting typ
ParamSettingExp SqlExpr (Value (Key Exp))
-> SqlExpr (Value (Key Exp)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key Exp -> SqlExpr (Value (Key Exp))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key Exp
kExp) SqlQuery ()
-> SqlQuery (SqlExpr (Entity ParamSetting))
-> SqlQuery (SqlExpr (Entity ParamSetting))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> SqlExpr (Entity ParamSetting)
-> SqlQuery (SqlExpr (Entity ParamSetting))
forall (m :: * -> *) a. Monad m => a -> m a
return SqlExpr (Entity ParamSetting)
pm)
  where
    mkParameterSetting' :: ParamSetting -> ParameterSetting a
mkParameterSetting' (ParamSetting Key Exp
_ Text
n ByteString
v Bool
b Int
design) = Text
-> ByteString -> Bool -> ExperimentDesign -> ParameterSetting a
forall a.
Text
-> ByteString -> Bool -> ExperimentDesign -> ParameterSetting a
ParameterSetting Text
n ByteString
v Bool
b (Int -> ExperimentDesign
forall a. Enum a => Int -> a
toEnum Int
design)

-- fromCount :: [E.Value Int] -> Int
-- fromCount = fromMaybe 0 . listToMaybe . fmap (\(E.Value v) -> v)

loadPreparationInputCount  :: (MonadIO m) => Key PrepResultData -> ReaderT SqlBackend m Int
loadPreparationInputCount :: Key PrepResultData -> ReaderT SqlBackend m Int
loadPreparationInputCount Key PrepResultData
kExpRes = [Filter PrepInput] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [EntityField PrepInput (Key PrepResultData)
forall typ. (typ ~ Key PrepResultData) => EntityField PrepInput typ
PrepInputPrepResultData EntityField PrepInput (Key PrepResultData)
-> Key PrepResultData -> Filter PrepInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
kExpRes]

loadPreparationInputWhere :: (MonadIO m, ExperimentDef a) => Key PrepResultData -> AvailabilityListWhere -> ConduitM () (Input a) (DB m) ()
loadPreparationInputWhere :: Key PrepResultData
-> AvailabilityListWhere -> ConduitM () (Input a) (DB m) ()
loadPreparationInputWhere Key PrepResultData
kExpRes (PrepInputWhere SqlExpr (Entity PrepInput)
-> SqlExpr (Entity PrepInputValue) -> SqlQuery ()
where') = do
  let src :: ConduitT () (Entity PrepInput, Entity PrepInputValue) (DB m) ()
src =
        SqlQuery
  (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
-> ConduitT () (Entity PrepInput, Entity PrepInputValue) (DB m) ()
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend,
 IsPersistBackend backend, PersistQueryRead backend,
 PersistStoreRead backend, PersistUniqueRead backend,
 MonadResource m) =>
SqlQuery a -> ConduitT () r (ReaderT backend m) ()
E.selectSource (SqlQuery
   (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
 -> ConduitT () (Entity PrepInput, Entity PrepInputValue) (DB m) ())
-> SqlQuery
     (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
-> ConduitT () (Entity PrepInput, Entity PrepInputValue) (DB m) ()
forall a b. (a -> b) -> a -> b
$
        ((SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
 -> SqlQuery
      (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue)))
-> SqlQuery
     (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
  -> SqlQuery
       (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue)))
 -> SqlQuery
      (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue)))
-> ((SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
    -> SqlQuery
         (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue)))
-> SqlQuery
     (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity PrepInput)
prepI, SqlExpr (Entity PrepInputValue)
prepIV) -> do
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepInput)
prepI SqlExpr (Entity PrepInput)
-> EntityField PrepInput (Key PrepInput)
-> SqlExpr (Value (Key PrepInput))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepInput (Key PrepInput)
forall typ. (typ ~ Key PrepInput) => EntityField PrepInput typ
PrepInputId SqlExpr (Value (Key PrepInput))
-> SqlExpr (Value (Key PrepInput)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity PrepInputValue)
prepIV SqlExpr (Entity PrepInputValue)
-> EntityField PrepInputValue (Key PrepInput)
-> SqlExpr (Value (Key PrepInput))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepInputValue (Key PrepInput)
forall typ. (typ ~ Key PrepInput) => EntityField PrepInputValue typ
PrepInputValuePrepInput)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepInput)
prepI SqlExpr (Entity PrepInput)
-> EntityField PrepInput (Key PrepResultData)
-> SqlExpr (Value (Key PrepResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepInput (Key PrepResultData)
forall typ. (typ ~ Key PrepResultData) => EntityField PrepInput typ
PrepInputPrepResultData SqlExpr (Value (Key PrepResultData))
-> SqlExpr (Value (Key PrepResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key PrepResultData -> SqlExpr (Value (Key PrepResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key PrepResultData
kExpRes)
          SqlExpr (Entity PrepInput)
-> SqlExpr (Entity PrepInputValue) -> SqlQuery ()
where' SqlExpr (Entity PrepInput)
prepI SqlExpr (Entity PrepInputValue)
prepIV
          (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
-> SqlQuery
     (SqlExpr (Entity PrepInput), SqlExpr (Entity PrepInputValue))
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity PrepInput)
prepI, SqlExpr (Entity PrepInputValue)
prepIV)
  ConduitT () (Entity PrepInput, Entity PrepInputValue) (DB m) ()
src ConduitT () (Entity PrepInput, Entity PrepInputValue) (DB m) ()
-> ConduitM
     (Entity PrepInput, Entity PrepInputValue) (Input a) (DB m) ()
-> ConduitM () (Input a) (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ((Entity PrepInput, Entity PrepInputValue)
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe (Input a)))
-> ConduitT
     (Entity PrepInput, Entity PrepInputValue)
     (Maybe (Input a))
     (DB m)
     ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapMC (Entity PrepInput, Entity PrepInputValue)
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe (Input a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, ExperimentDef a) =>
(Entity PrepInput, Entity PrepInputValue) -> m (Maybe (Input a))
mkInput ConduitT
  (Entity PrepInput, Entity PrepInputValue)
  (Maybe (Input a))
  (DB m)
  ()
-> ConduitM (Maybe (Input a)) (Input a) (DB m) ()
-> ConduitM
     (Entity PrepInput, Entity PrepInputValue) (Input a) (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| [Maybe (Input a)] -> ConduitM (Maybe (Input a)) (Input a) (DB m) ()
forall (m :: * -> *) o.
Monad m =>
[Maybe o] -> ConduitT (Maybe o) o m ()
sequenceC []
  -- sequence <$> mapM mkInput res
  where
    mkInput :: (MonadIO m, MonadLogger m, ExperimentDef a) => (Entity PrepInput, Entity PrepInputValue) -> m (Maybe (Input a))
    mkInput :: (Entity PrepInput, Entity PrepInputValue) -> m (Maybe (Input a))
mkInput (Entity Key PrepInput
_ (PrepInput Key PrepResultData
_ Int
p), Entity Key PrepInputValue
_ (PrepInputValue Key PrepInput
_ ByteString
v)) = do
      Maybe (InputValue a)
v' <- Text -> ByteString -> m (Maybe (InputValue a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"prep input value" ByteString
v
      Maybe (Input a) -> m (Maybe (Input a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Input a) -> m (Maybe (Input a)))
-> Maybe (Input a) -> m (Maybe (Input a))
forall a b. (a -> b) -> a -> b
$ Int -> InputValue a -> Input a
forall a. Int -> InputValue a -> Input a
Input Int
p (InputValue a -> Input a)
-> Maybe (InputValue a) -> Maybe (Input a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputValue a)
v'
loadPreparationInputWhere Key PrepResultData
kExpRes AvailabilityListWhere
GetAll = Key PrepResultData
-> AvailabilityListWhere -> ConduitM () (Input a) (DB m) ()
forall (m :: * -> *) a.
(MonadIO m, ExperimentDef a) =>
Key PrepResultData
-> AvailabilityListWhere -> ConduitM () (Input a) (DB m) ()
loadPreparationInputWhere Key PrepResultData
kExpRes ((SqlExpr (Entity PrepInput)
 -> SqlExpr (Entity PrepInputValue) -> SqlQuery ())
-> AvailabilityListWhere
PrepInputWhere (\SqlExpr (Entity PrepInput)
_ SqlExpr (Entity PrepInputValue)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadPreparationInputWhere Key PrepResultData
_ AvailabilityListWhere
where' = [Char] -> ConduitM () (Input a) (DB m) ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ConduitM () (Input a) (DB m) ())
-> [Char] -> ConduitM () (Input a) (DB m) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepInputWhere was expected"


sequenceC :: Monad m => [Maybe o] -> ConduitT (Maybe o) o m ()
sequenceC :: [Maybe o] -> ConduitT (Maybe o) o m ()
sequenceC [Maybe o]
xs = do
      Maybe (Maybe o)
mx <- ConduitT (Maybe o) o m (Maybe (Maybe o))
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
      case Maybe (Maybe o)
mx of
        Maybe (Maybe o)
Nothing -> [o] -> ConduitT (Maybe o) o m ()
forall (m :: * -> *) a i. Monad m => [a] -> ConduitT i a m ()
CL.sourceList ([o] -> Maybe [o] -> [o]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [o] -> [o]) -> Maybe [o] -> [o]
forall a b. (a -> b) -> a -> b
$ [Maybe o] -> Maybe [o]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Maybe o] -> Maybe [o]) -> [Maybe o] -> Maybe [o]
forall a b. (a -> b) -> a -> b
$ [Maybe o] -> [Maybe o]
forall a. [a] -> [a]
reverse [Maybe o]
xs)
        Just Maybe o
x  -> [Maybe o] -> ConduitT (Maybe o) o m ()
forall (m :: * -> *) o.
Monad m =>
[Maybe o] -> ConduitT (Maybe o) o m ()
sequenceC (Maybe o
xMaybe o -> [Maybe o] -> [Maybe o]
forall a. a -> [a] -> [a]
:[Maybe o]
xs)


loadPrepartionMeasuresCount :: (MonadIO m) => Key PrepResultData -> DB m Int
loadPrepartionMeasuresCount :: Key PrepResultData -> DB m Int
loadPrepartionMeasuresCount Key PrepResultData
kExpRes = [Filter PrepMeasure] -> DB m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [EntityField PrepMeasure (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepMeasure typ
PrepMeasurePrepResultData EntityField PrepMeasure (Key PrepResultData)
-> Key PrepResultData -> Filter PrepMeasure
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
kExpRes]

-- loadPrepartionMeasures :: (MonadIO m) => Key PrepResultData -> ConduitT () Measure (DB m) ()
-- loadPrepartionMeasures = loadPrepartionMeasuresWith (\_ _ -> return ())

loadPreparationMeasuresWhere :: (MonadIO m) => Key PrepResultData -> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadPreparationMeasuresWhere :: Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadPreparationMeasuresWhere Key PrepResultData
kExpRes (PrepMeasureWhere SqlExpr (Entity PrepMeasure)
-> SqlExpr (Entity PrepResultStep) -> SqlQuery ()
where') = do
  let src :: ConduitT () (Entity PrepMeasure, Entity PrepResultStep) (DB m) ()
src =
        SqlQuery
  (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
-> ConduitT
     () (Entity PrepMeasure, Entity PrepResultStep) (DB m) ()
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend,
 IsPersistBackend backend, PersistQueryRead backend,
 PersistStoreRead backend, PersistUniqueRead backend,
 MonadResource m) =>
SqlQuery a -> ConduitT () r (ReaderT backend m) ()
E.selectSource (SqlQuery
   (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
 -> ConduitT
      () (Entity PrepMeasure, Entity PrepResultStep) (DB m) ())
-> SqlQuery
     (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
-> ConduitT
     () (Entity PrepMeasure, Entity PrepResultStep) (DB m) ()
forall a b. (a -> b) -> a -> b
$
        ((SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
 -> SqlQuery
      (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep)))
-> SqlQuery
     (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
  -> SqlQuery
       (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep)))
 -> SqlQuery
      (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep)))
-> ((SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
    -> SqlQuery
         (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep)))
-> SqlQuery
     (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity PrepMeasure)
prepM, SqlExpr (Entity PrepResultStep)
prepRS) -> do
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepMeasure)
prepM SqlExpr (Entity PrepMeasure)
-> EntityField PrepMeasure (Key PrepMeasure)
-> SqlExpr (Value (Key PrepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepMeasure (Key PrepMeasure)
forall typ. (typ ~ Key PrepMeasure) => EntityField PrepMeasure typ
PrepMeasureId SqlExpr (Value (Key PrepMeasure))
-> SqlExpr (Value (Key PrepMeasure)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity PrepResultStep)
prepRS SqlExpr (Entity PrepResultStep)
-> EntityField PrepResultStep (Key PrepMeasure)
-> SqlExpr (Value (Key PrepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepResultStep (Key PrepMeasure)
forall typ.
(typ ~ Key PrepMeasure) =>
EntityField PrepResultStep typ
PrepResultStepMeasure)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepMeasure)
prepM SqlExpr (Entity PrepMeasure)
-> EntityField PrepMeasure (Key PrepResultData)
-> SqlExpr (Value (Key PrepResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepMeasure (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepMeasure typ
PrepMeasurePrepResultData SqlExpr (Value (Key PrepResultData))
-> SqlExpr (Value (Key PrepResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key PrepResultData -> SqlExpr (Value (Key PrepResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key PrepResultData
kExpRes)
          SqlExpr (Entity PrepMeasure)
-> SqlExpr (Entity PrepResultStep) -> SqlQuery ()
where' SqlExpr (Entity PrepMeasure)
prepM SqlExpr (Entity PrepResultStep)
prepRS
          [SqlExpr OrderBy] -> SqlQuery ()
E.orderBy [SqlExpr (Value Int) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity PrepMeasure)
prepM SqlExpr (Entity PrepMeasure)
-> EntityField PrepMeasure Int -> SqlExpr (Value Int)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepMeasure Int
forall typ. (typ ~ Int) => EntityField PrepMeasure typ
PrepMeasurePeriod)]
          (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
-> SqlQuery
     (SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity PrepMeasure)
prepM, SqlExpr (Entity PrepResultStep)
prepRS)
  ConduitT () (Entity PrepMeasure, Entity PrepResultStep) (DB m) ()
src ConduitT () (Entity PrepMeasure, Entity PrepResultStep) (DB m) ()
-> ConduitM
     (Entity PrepMeasure, Entity PrepResultStep) Measure (DB m) ()
-> ConduitT () Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ((Entity PrepMeasure, Entity PrepResultStep) -> Measure)
-> ConduitM
     (Entity PrepMeasure, Entity PrepResultStep) Measure (DB m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (Entity PrepMeasure, Entity PrepResultStep) -> Measure
mkMeasure ConduitM
  (Entity PrepMeasure, Entity PrepResultStep) Measure (DB m) ()
-> ConduitM Measure Measure (DB m) ()
-> ConduitM
     (Entity PrepMeasure, Entity PrepResultStep) Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| (Measure -> Measure -> Bool)
-> ConduitT Measure [Measure] (DB m) ()
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> ConduitT a [a] m ()
CL.groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Measure -> Int) -> Measure -> Measure -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Int Measure Int -> Measure -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Measure Int
Lens' Measure Int
measurePeriod) ConduitT Measure [Measure] (DB m) ()
-> ConduitM [Measure] Measure (DB m) ()
-> ConduitM Measure Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ([Measure] -> Measure) -> ConduitM [Measure] Measure (DB m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC [Measure] -> Measure
combineMeasures
  -- return $ map combineMeasures $ L.groupBy ((==) `on` view measurePeriod) $ map mkMeasure res
  where
    mkMeasure :: (Entity PrepMeasure, Entity PrepResultStep) -> Measure
mkMeasure (Entity Key PrepMeasure
_ (PrepMeasure Key PrepResultData
_ Int
p), Entity Key PrepResultStep
_ (PrepResultStep Key PrepMeasure
_ Text
n Maybe Double
x Double
y)) = Int -> [StepResult] -> Measure
Measure Int
p [Text -> Maybe Double -> Double -> StepResult
StepResult Text
n Maybe Double
x Double
y]
    combineMeasures :: [Measure] -> Measure
combineMeasures xs :: [Measure]
xs@(Measure Int
p [StepResult]
_:[Measure]
_) = Int -> [StepResult] -> Measure
Measure Int
p ((Measure -> [StepResult]) -> [Measure] -> [StepResult]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Getting [StepResult] Measure [StepResult]
-> Measure -> [StepResult]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [StepResult] Measure [StepResult]
Lens' Measure [StepResult]
measureResults) [Measure]
xs)
    combineMeasures [Measure]
_                  = [Char] -> Measure
forall a. HasCallStack => [Char] -> a
error [Char]
"not possible"
loadPreparationMeasuresWhere Key PrepResultData
kExpRes AvailabilityListWhere
GetAll = Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
forall (m :: * -> *).
MonadIO m =>
Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadPreparationMeasuresWhere Key PrepResultData
kExpRes ((SqlExpr (Entity PrepMeasure)
 -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
PrepMeasureWhere (\SqlExpr (Entity PrepMeasure)
_ SqlExpr (Entity PrepResultStep)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadPreparationMeasuresWhere Key PrepResultData
_ AvailabilityListWhere
where' = [Char] -> ConduitT () Measure (DB m) ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ConduitT () Measure (DB m) ())
-> [Char] -> ConduitT () Measure (DB m) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepMeasuresWhere was expected"


loadPreparationAggregateWhere :: (MonadIO m) => Key PrepResultData -> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadPreparationAggregateWhere :: Key PrepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadPreparationAggregateWhere Key PrepResultData
kExpRes AggregateFunction
agg (PrepMeasureWhere SqlExpr (Entity PrepMeasure)
-> SqlExpr (Entity PrepResultStep) -> SqlQuery ()
where') =
  ([Value (Maybe Double)] -> Double)
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
-> DB m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double)
-> ([Value (Maybe Double)] -> Maybe Double)
-> [Value (Maybe Double)]
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value (Maybe Double) -> Maybe Double
forall a. Value a -> a
E.unValue (Value (Maybe Double) -> Maybe Double)
-> ([Value (Maybe Double)] -> Value (Maybe Double))
-> [Value (Maybe Double)]
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value (Maybe Double)] -> Value (Maybe Double)
forall a. [a] -> a
head) (ReaderT SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
 -> DB m Double)
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
-> DB m Double
forall a b. (a -> b) -> a -> b
$
  SqlQuery (SqlExpr (Value (Maybe Double)))
-> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)]
forall a r (m :: * -> *).
(SqlSelect a r, MonadIO m) =>
SqlQuery a -> SqlReadT m [r]
E.select (SqlQuery (SqlExpr (Value (Maybe Double)))
 -> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)])
-> SqlQuery (SqlExpr (Value (Maybe Double)))
-> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)]
forall a b. (a -> b) -> a -> b
$
  ((SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
 -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
  -> SqlQuery (SqlExpr (Value (Maybe Double))))
 -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> ((SqlExpr (Entity PrepMeasure), SqlExpr (Entity PrepResultStep))
    -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity PrepMeasure)
prepM, SqlExpr (Entity PrepResultStep)
prepRS) -> do
    SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepMeasure)
prepM SqlExpr (Entity PrepMeasure)
-> EntityField PrepMeasure (Key PrepMeasure)
-> SqlExpr (Value (Key PrepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepMeasure (Key PrepMeasure)
forall typ. (typ ~ Key PrepMeasure) => EntityField PrepMeasure typ
PrepMeasureId SqlExpr (Value (Key PrepMeasure))
-> SqlExpr (Value (Key PrepMeasure)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity PrepResultStep)
prepRS SqlExpr (Entity PrepResultStep)
-> EntityField PrepResultStep (Key PrepMeasure)
-> SqlExpr (Value (Key PrepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepResultStep (Key PrepMeasure)
forall typ.
(typ ~ Key PrepMeasure) =>
EntityField PrepResultStep typ
PrepResultStepMeasure)
    SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepMeasure)
prepM SqlExpr (Entity PrepMeasure)
-> EntityField PrepMeasure (Key PrepResultData)
-> SqlExpr (Value (Key PrepResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepMeasure (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepMeasure typ
PrepMeasurePrepResultData SqlExpr (Value (Key PrepResultData))
-> SqlExpr (Value (Key PrepResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key PrepResultData -> SqlExpr (Value (Key PrepResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key PrepResultData
kExpRes)
    SqlExpr (Entity PrepMeasure)
-> SqlExpr (Entity PrepResultStep) -> SqlQuery ()
where' SqlExpr (Entity PrepMeasure)
prepM SqlExpr (Entity PrepResultStep)
prepRS
    SqlExpr (Value (Maybe Double))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall (m :: * -> *) a. Monad m => a -> m a
return (AggregateFunction
agg AggregateFunction -> AggregateFunction
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity PrepResultStep)
prepRS SqlExpr (Entity PrepResultStep)
-> EntityField PrepResultStep Double -> SqlExpr (Value Double)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField PrepResultStep Double
forall typ. (typ ~ Double) => EntityField PrepResultStep typ
PrepResultStepYValue)
loadPreparationAggregateWhere Key PrepResultData
kExpRes AggregateFunction
agg AvailabilityListWhere
GetAll = Key PrepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
forall (m :: * -> *).
MonadIO m =>
Key PrepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadPreparationAggregateWhere Key PrepResultData
kExpRes AggregateFunction
agg ((SqlExpr (Entity PrepMeasure)
 -> SqlExpr (Entity PrepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
PrepMeasureWhere (\SqlExpr (Entity PrepMeasure)
_ SqlExpr (Entity PrepResultStep)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadPreparationAggregateWhere Key PrepResultData
_ AggregateFunction
_ AvailabilityListWhere
where' = [Char] -> DB m Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> DB m Double) -> [Char] -> DB m Double
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where loadPreparationAggregateWhere was expected"


loadReplicationResults :: (ExperimentDef a) => Key Exp -> Key ExpResult -> DB (ExpM a) [ReplicationResult a]
loadReplicationResults :: Key Exp -> Key ExpResult -> DB (ExpM a) [ReplicationResult a]
loadReplicationResults Key Exp
expId Key ExpResult
kExpRes = do
  [Entity RepResult]
xs <- [Filter RepResult]
-> [SelectOpt RepResult]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity RepResult]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField RepResult (Key ExpResult)
forall typ. (typ ~ Key ExpResult) => EntityField RepResult typ
RepResultExpResult EntityField RepResult (Key ExpResult)
-> Key ExpResult -> Filter RepResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key ExpResult
kExpRes] [EntityField RepResult Int -> SelectOpt RepResult
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField RepResult Int
forall typ. (typ ~ Int) => EntityField RepResult typ
RepResultRepNr]
  (Entity RepResult
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (ReplicationResult a))
-> [Entity RepResult] -> DB (ExpM a) [ReplicationResult a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Key Exp
-> Entity RepResult
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ReplicationResult a)
forall a.
ExperimentDef a =>
Key Exp -> Entity RepResult -> DB (ExpM a) (ReplicationResult a)
loadReplicationResult Key Exp
expId) [Entity RepResult]
xs


loadReplicationResult :: (ExperimentDef a) => Key Exp -> Entity RepResult -> DB (ExpM a) (ReplicationResult a)
loadReplicationResult :: Key Exp -> Entity RepResult -> DB (ExpM a) (ReplicationResult a)
loadReplicationResult Key Exp
expId (Entity Key RepResult
k (RepResult Key ExpResult
_ Int
repNr Maybe (Key WarmUpResultData)
mWmUpResId Maybe (Key RepResultData)
mRepResId)) = do
  !Maybe (Entity WarmUpResultData)
mWmUpRes <- (Maybe (Maybe (Entity WarmUpResultData))
 -> Maybe (Entity WarmUpResultData))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity WarmUpResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity WarmUpResultData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe (Entity WarmUpResultData))
-> Maybe (Entity WarmUpResultData)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ReaderT
   SqlBackend
   (LoggingT (ResourceT (ExpM a)))
   (Maybe (Maybe (Entity WarmUpResultData)))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity WarmUpResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity WarmUpResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity WarmUpResultData))
forall a b. (a -> b) -> a -> b
$ Maybe
  (ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity WarmUpResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity WarmUpResultData)))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe
   (ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity WarmUpResultData)))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Maybe (Entity WarmUpResultData))))
-> Maybe
     (ReaderT
        SqlBackend
        (LoggingT (ResourceT (ExpM a)))
        (Maybe (Entity WarmUpResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity WarmUpResultData)))
forall a b. (a -> b) -> a -> b
$ Key WarmUpResultData
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity WarmUpResultData))
forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
P.getEntity (Key WarmUpResultData
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity WarmUpResultData)))
-> Maybe (Key WarmUpResultData)
-> Maybe
     (ReaderT
        SqlBackend
        (LoggingT (ResourceT (ExpM a)))
        (Maybe (Entity WarmUpResultData)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Key WarmUpResultData)
mWmUpResId
  !Maybe (Entity RepResultData)
mRepRes <- (Maybe (Maybe (Entity RepResultData))
 -> Maybe (Entity RepResultData))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity RepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity RepResultData))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe (Entity RepResultData))
-> Maybe (Entity RepResultData)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (ReaderT
   SqlBackend
   (LoggingT (ResourceT (ExpM a)))
   (Maybe (Maybe (Entity RepResultData)))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity RepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity RepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity RepResultData))
forall a b. (a -> b) -> a -> b
$ Maybe
  (ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity RepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity RepResultData)))
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Maybe
   (ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity RepResultData)))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Maybe (Entity RepResultData))))
-> Maybe
     (ReaderT
        SqlBackend
        (LoggingT (ResourceT (ExpM a)))
        (Maybe (Entity RepResultData)))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (Entity RepResultData)))
forall a b. (a -> b) -> a -> b
$ Key RepResultData
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Entity RepResultData))
forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
P.getEntity (Key RepResultData
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Entity RepResultData)))
-> Maybe (Key RepResultData)
-> Maybe
     (ReaderT
        SqlBackend
        (LoggingT (ResourceT (ExpM a)))
        (Maybe (Entity RepResultData)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Key RepResultData)
mRepResId
  !Maybe (ResultData a)
wmUp <-
    case Maybe (Entity WarmUpResultData)
mWmUpRes of
      Maybe (Entity WarmUpResultData)
Nothing    -> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
forall a. Maybe a
Nothing
      Just Entity WarmUpResultData
eWmUp -> Entity WarmUpResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
mkWmUp Entity WarmUpResultData
eWmUp
  !Maybe (ResultData a)
rep <-
    case Maybe (Entity RepResultData)
mRepRes of
      Maybe (Entity RepResultData)
Nothing   -> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
forall a. Maybe a
Nothing
      Just Entity RepResultData
eRep -> Entity RepResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
mkRep Entity RepResultData
eRep
  ReplicationResult a -> DB (ExpM a) (ReplicationResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplicationResult a -> DB (ExpM a) (ReplicationResult a))
-> ReplicationResult a -> DB (ExpM a) (ReplicationResult a)
forall a b. NFData a => (a -> b) -> a -> b
$!! Key RepResult
-> Int
-> Maybe (ResultData a)
-> Maybe (ResultData a)
-> ReplicationResult a
forall a.
Key RepResult
-> Int
-> Maybe (ResultData a)
-> Maybe (ResultData a)
-> ReplicationResult a
ReplicationResult Key RepResult
k Int
repNr Maybe (ResultData a)
wmUp Maybe (ResultData a)
rep
  where
    mkWmUp :: Entity WarmUpResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
mkWmUp (Entity Key WarmUpResultData
wmUpResKey WarmUpResultData
wmUpRes) = do
      let wmUpStartTime :: UTCTime
wmUpStartTime = Getting UTCTime WarmUpResultData UTCTime
-> WarmUpResultData -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime WarmUpResultData UTCTime
forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> WarmUpResultData -> f WarmUpResultData
warmUpResultDataStartTime WarmUpResultData
wmUpRes
      let wmUpEndTime :: Maybe UTCTime
wmUpEndTime = Getting (Maybe UTCTime) WarmUpResultData (Maybe UTCTime)
-> WarmUpResultData -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) WarmUpResultData (Maybe UTCTime)
forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime))
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataEndTime WarmUpResultData
wmUpRes
      !Gen RealWorld
wmUpStartRandGen <- ByteString
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) GenIO
forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen (Getting ByteString WarmUpResultData ByteString
-> WarmUpResultData -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString WarmUpResultData ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataStartRandGen WarmUpResultData
wmUpRes)
      !Maybe (Gen RealWorld)
wmUpEndRandGen <- ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
-> (ByteString
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld)))
-> Maybe ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Gen RealWorld)
forall a. Maybe a
Nothing) ((Gen RealWorld -> Maybe (Gen RealWorld))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Gen RealWorld -> Maybe (Gen RealWorld)
forall a. a -> Maybe a
Just (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld)))
-> (ByteString
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld))
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen) (Getting (Maybe ByteString) WarmUpResultData (Maybe ByteString)
-> WarmUpResultData -> Maybe ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ByteString) WarmUpResultData (Maybe ByteString)
forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataEndRandGen WarmUpResultData
wmUpRes)
      let !wmUpStartSt :: Availability (ExpM a) a
wmUpStartSt = DB (ExpM a) a -> Availability (ExpM a) a
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (Key Exp -> StartStateType -> DB (ExpM a) a
forall a.
ExperimentDef a =>
Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId (Key WarmUpResultData -> StartStateType
StartStateWarmUp Key WarmUpResultData
wmUpResKey))
      let !wmUpEndSt :: Availability (ExpM a) (Maybe a)
wmUpEndSt = DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId (Key WarmUpResultData -> EndStateType
EndStateWarmUp Key WarmUpResultData
wmUpResKey))
      !Maybe (InputState a)
mWmUpStartInpSt <- Text
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (InputState a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"warm up start input state" (Getting ByteString WarmUpResultData ByteString
-> WarmUpResultData -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString WarmUpResultData ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataStartInputState WarmUpResultData
wmUpRes)
      !Maybe (Maybe (InputState a))
mWmUpEndInpSt <- Text
-> Maybe ByteString
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (InputState a)))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise Text
"warm up end input state" (Getting (Maybe ByteString) WarmUpResultData (Maybe ByteString)
-> WarmUpResultData -> Maybe ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ByteString) WarmUpResultData (Maybe ByteString)
forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataEndInputState WarmUpResultData
wmUpRes)
      !Int
wmUpInpValsCount <- Key WarmUpResultData
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpInputCount Key WarmUpResultData
wmUpResKey
      !Int
wmUpMeasuresCount <- Key WarmUpResultData
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpMeasuresCount Key WarmUpResultData
wmUpResKey
      let !wmUpInpVals :: AvailabilityList (ExpM a) (Input a)
wmUpInpVals = (Int,
 AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) (Input a)
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
wmUpInpValsCount, Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ()
forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationWarmUpInputWhere Key WarmUpResultData
wmUpResKey)
          !wmUpMeasures :: AvailabilityList (ExpM a) Measure
wmUpMeasures = (Int,
 AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) Measure
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
wmUpMeasuresCount, Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData
-> AvailabilityListWhere -> ConduitM () Measure (DB m) ()
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
wmUpResKey)
      Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ResultData a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a)))
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall a b. (a -> b) -> a -> b
$!
        ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
forall a.
ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
ResultData (Key WarmUpResultData -> ResultDataKey
ResultDataWarmUp Key WarmUpResultData
wmUpResKey) UTCTime
wmUpStartTime Maybe UTCTime
wmUpEndTime Gen RealWorld
GenIO
wmUpStartRandGen Maybe (Gen RealWorld)
Maybe GenIO
wmUpEndRandGen AvailabilityList (ExpM a) (Input a)
wmUpInpVals AvailabilityList (ExpM a) Measure
wmUpMeasures Availability (ExpM a) a
wmUpStartSt Availability (ExpM a) (Maybe a)
wmUpEndSt (InputState a -> Maybe (InputState a) -> ResultData a)
-> Maybe (InputState a)
-> Maybe (Maybe (InputState a) -> ResultData a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
mWmUpStartInpSt Maybe (Maybe (InputState a) -> ResultData a)
-> Maybe (Maybe (InputState a)) -> Maybe (ResultData a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
        Maybe (Maybe (InputState a))
mWmUpEndInpSt
    mkRep :: Entity RepResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
mkRep (Entity Key RepResultData
repResKey RepResultData
repRes) = do
      let repStartTime :: UTCTime
repStartTime = Getting UTCTime RepResultData UTCTime -> RepResultData -> UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting UTCTime RepResultData UTCTime
forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> RepResultData -> f RepResultData
repResultDataStartTime RepResultData
repRes
      let repEndTime :: Maybe UTCTime
repEndTime = Getting (Maybe UTCTime) RepResultData (Maybe UTCTime)
-> RepResultData -> Maybe UTCTime
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe UTCTime) RepResultData (Maybe UTCTime)
forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime))
-> RepResultData -> f RepResultData
repResultDataEndTime RepResultData
repRes
      !Gen RealWorld
repStartRandGen <- ByteString
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) GenIO
forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen (Getting ByteString RepResultData ByteString
-> RepResultData -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString RepResultData ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString) -> RepResultData -> f RepResultData
repResultDataStartRandGen RepResultData
repRes)
      !Maybe (Gen RealWorld)
repEndRandGen <- ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
-> (ByteString
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld)))
-> Maybe ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Gen RealWorld)
forall a. Maybe a
Nothing) ((Gen RealWorld -> Maybe (Gen RealWorld))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Gen RealWorld -> Maybe (Gen RealWorld)
forall a. a -> Maybe a
Just (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld)))
-> (ByteString
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld))
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Gen RealWorld))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen) (Getting (Maybe ByteString) RepResultData (Maybe ByteString)
-> RepResultData -> Maybe ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ByteString) RepResultData (Maybe ByteString)
forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> RepResultData -> f RepResultData
repResultDataEndRandGen RepResultData
repRes)
      !Maybe (InputState a)
mRepStartInpSt <- Text
-> ByteString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (InputState a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"rep start input state" (Getting ByteString RepResultData ByteString
-> RepResultData -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString RepResultData ByteString
forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString) -> RepResultData -> f RepResultData
repResultDataStartInputState RepResultData
repRes)
      !Maybe (Maybe (InputState a))
mRepEndInpSt <- Text
-> Maybe ByteString
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Maybe (InputState a)))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise Text
"rep end input state" (Getting (Maybe ByteString) RepResultData (Maybe ByteString)
-> RepResultData -> Maybe ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe ByteString) RepResultData (Maybe ByteString)
forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> RepResultData -> f RepResultData
repResultDataEndInputState RepResultData
repRes)
      !Int
repInpValsCount <- Key RepResultData
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *).
MonadIO m =>
Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationInputCount Key RepResultData
repResKey
      !Int
repMeasuresCount <- Key RepResultData
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *).
MonadIO m =>
Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationMeasuresCount Key RepResultData
repResKey
      let !repInpVals :: AvailabilityList (ExpM a) (Input a)
repInpVals = (Int,
 AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) (Input a)
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
repInpValsCount, Key RepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ()
forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
Key RepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationInputWhere Key RepResultData
repResKey)
          !repMeasures :: AvailabilityList (ExpM a) Measure
repMeasures = (Int,
 AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) Measure
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
repMeasuresCount, Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *).
MonadIO m =>
Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadReplicationMeasuresWhere Key RepResultData
repResKey)
      let !repStartSt :: Availability (ExpM a) a
repStartSt = DB (ExpM a) a -> Availability (ExpM a) a
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (Key Exp -> StartStateType -> DB (ExpM a) a
forall a.
ExperimentDef a =>
Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId (Key RepResultData -> StartStateType
StartStateRep Key RepResultData
repResKey))
      let !repEndSt :: Availability (ExpM a) (Maybe a)
repEndSt = DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId (Key RepResultData -> EndStateType
EndStateRep Key RepResultData
repResKey))
      Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (ResultData a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a)))
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall a b. (a -> b) -> a -> b
$!
        ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
forall a.
ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
ResultData (Key RepResultData -> ResultDataKey
ResultDataRep Key RepResultData
repResKey) UTCTime
repStartTime Maybe UTCTime
repEndTime Gen RealWorld
GenIO
repStartRandGen Maybe (Gen RealWorld)
Maybe GenIO
repEndRandGen AvailabilityList (ExpM a) (Input a)
repInpVals AvailabilityList (ExpM a) Measure
repMeasures Availability (ExpM a) a
repStartSt Availability (ExpM a) (Maybe a)
repEndSt (InputState a -> Maybe (InputState a) -> ResultData a)
-> Maybe (InputState a)
-> Maybe (Maybe (InputState a) -> ResultData a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
mRepStartInpSt Maybe (Maybe (InputState a) -> ResultData a)
-> Maybe (Maybe (InputState a)) -> Maybe (ResultData a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Maybe (InputState a))
mRepEndInpSt


loadReplicationWarmUpInputCount :: (MonadIO m) => Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpInputCount :: Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpInputCount Key WarmUpResultData
kExpRes = [Filter WarmUpInput] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [EntityField WarmUpInput (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpInput typ
WarmUpInputRepResult EntityField WarmUpInput (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
kExpRes]


loadReplicationWarmUpInputWhere :: (ExperimentDef a, MonadIO m) => Key WarmUpResultData -> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationWarmUpInputWhere :: Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationWarmUpInputWhere Key WarmUpResultData
kExpRes (WarmUpInputWhere SqlExpr (Entity WarmUpInput)
-> SqlExpr (Entity WarmUpInputValue) -> SqlQuery ()
where') = do
  let src :: ConduitT () (Entity WarmUpInput, Entity WarmUpInputValue) (DB m) ()
src =
       SqlQuery
  (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
-> ConduitT
     () (Entity WarmUpInput, Entity WarmUpInputValue) (DB m) ()
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend,
 IsPersistBackend backend, PersistQueryRead backend,
 PersistStoreRead backend, PersistUniqueRead backend,
 MonadResource m) =>
SqlQuery a -> ConduitT () r (ReaderT backend m) ()
E.selectSource (SqlQuery
   (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
 -> ConduitT
      () (Entity WarmUpInput, Entity WarmUpInputValue) (DB m) ())
-> SqlQuery
     (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
-> ConduitT
     () (Entity WarmUpInput, Entity WarmUpInputValue) (DB m) ()
forall a b. (a -> b) -> a -> b
$
       ((SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
 -> SqlQuery
      (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue)))
-> SqlQuery
     (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
  -> SqlQuery
       (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue)))
 -> SqlQuery
      (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue)))
-> ((SqlExpr (Entity WarmUpInput),
     SqlExpr (Entity WarmUpInputValue))
    -> SqlQuery
         (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue)))
-> SqlQuery
     (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity WarmUpInput)
warmUpI, SqlExpr (Entity WarmUpInputValue)
warmUpIV) -> do
         SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpInput)
warmUpI SqlExpr (Entity WarmUpInput)
-> EntityField WarmUpInput (Key WarmUpInput)
-> SqlExpr (Value (Key WarmUpInput))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpInput (Key WarmUpInput)
forall typ. (typ ~ Key WarmUpInput) => EntityField WarmUpInput typ
WarmUpInputId SqlExpr (Value (Key WarmUpInput))
-> SqlExpr (Value (Key WarmUpInput)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity WarmUpInputValue)
warmUpIV SqlExpr (Entity WarmUpInputValue)
-> EntityField WarmUpInputValue (Key WarmUpInput)
-> SqlExpr (Value (Key WarmUpInput))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpInputValue (Key WarmUpInput)
forall typ.
(typ ~ Key WarmUpInput) =>
EntityField WarmUpInputValue typ
WarmUpInputValueWarmUpInput)
         SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpInput)
warmUpI SqlExpr (Entity WarmUpInput)
-> EntityField WarmUpInput (Key WarmUpResultData)
-> SqlExpr (Value (Key WarmUpResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpInput (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpInput typ
WarmUpInputRepResult SqlExpr (Value (Key WarmUpResultData))
-> SqlExpr (Value (Key WarmUpResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key WarmUpResultData -> SqlExpr (Value (Key WarmUpResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key WarmUpResultData
kExpRes)
         SqlExpr (Entity WarmUpInput)
-> SqlExpr (Entity WarmUpInputValue) -> SqlQuery ()
where' SqlExpr (Entity WarmUpInput)
warmUpI SqlExpr (Entity WarmUpInputValue)
warmUpIV
         (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
-> SqlQuery
     (SqlExpr (Entity WarmUpInput), SqlExpr (Entity WarmUpInputValue))
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity WarmUpInput)
warmUpI, SqlExpr (Entity WarmUpInputValue)
warmUpIV)
  ConduitT () (Entity WarmUpInput, Entity WarmUpInputValue) (DB m) ()
src ConduitT () (Entity WarmUpInput, Entity WarmUpInputValue) (DB m) ()
-> ConduitM
     (Entity WarmUpInput, Entity WarmUpInputValue) (Input a) (DB m) ()
-> ConduitT () (Input a) (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ((Entity WarmUpInput, Entity WarmUpInputValue)
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe (Input a)))
-> ConduitT
     (Entity WarmUpInput, Entity WarmUpInputValue)
     (Maybe (Input a))
     (DB m)
     ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapMC (Entity WarmUpInput, Entity WarmUpInputValue)
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe (Input a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize (InputValue a)) =>
(Entity WarmUpInput, Entity WarmUpInputValue)
-> m (Maybe (Input a))
mkInput ConduitT
  (Entity WarmUpInput, Entity WarmUpInputValue)
  (Maybe (Input a))
  (DB m)
  ()
-> ConduitM (Maybe (Input a)) (Input a) (DB m) ()
-> ConduitM
     (Entity WarmUpInput, Entity WarmUpInputValue) (Input a) (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| [Maybe (Input a)] -> ConduitM (Maybe (Input a)) (Input a) (DB m) ()
forall (m :: * -> *) o.
Monad m =>
[Maybe o] -> ConduitT (Maybe o) o m ()
sequenceC []
  -- sequence <$> mapM mkInput res
  where
    mkInput :: (Entity WarmUpInput, Entity WarmUpInputValue)
-> m (Maybe (Input a))
mkInput (Entity Key WarmUpInput
_ (WarmUpInput Key WarmUpResultData
_ Int
p), Entity Key WarmUpInputValue
_ (WarmUpInputValue Key WarmUpInput
_ ByteString
v)) = do
      Maybe (InputValue a)
v' <- Text -> ByteString -> m (Maybe (InputValue a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"warm up input value" ByteString
v
      Maybe (Input a) -> m (Maybe (Input a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Input a) -> m (Maybe (Input a)))
-> Maybe (Input a) -> m (Maybe (Input a))
forall a b. (a -> b) -> a -> b
$ Int -> InputValue a -> Input a
forall a. Int -> InputValue a -> Input a
Input Int
p (InputValue a -> Input a)
-> Maybe (InputValue a) -> Maybe (Input a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputValue a)
v'
loadReplicationWarmUpInputWhere Key WarmUpResultData
kExpRes AvailabilityListWhere
GetAll = Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationWarmUpInputWhere Key WarmUpResultData
kExpRes ((SqlExpr (Entity WarmUpInput)
 -> SqlExpr (Entity WarmUpInputValue) -> SqlQuery ())
-> AvailabilityListWhere
WarmUpInputWhere (\SqlExpr (Entity WarmUpInput)
_ SqlExpr (Entity WarmUpInputValue)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationWarmUpInputWhere Key WarmUpResultData
_ AvailabilityListWhere
where' = [Char] -> ConduitT () (Input a) (DB m) ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ConduitT () (Input a) (DB m) ())
-> [Char] -> ConduitT () (Input a) (DB m) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepInputWhere was expected"


loadReplicationWarmUpMeasuresCount :: (MonadIO m) => Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpMeasuresCount :: Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpMeasuresCount Key WarmUpResultData
kExpRes = [Filter WarmUpMeasure] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [EntityField WarmUpMeasure (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpMeasure typ
WarmUpMeasureRepResult EntityField WarmUpMeasure (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpMeasure
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
kExpRes]

loadReplicationWarmUpMeasuresWhere :: (MonadIO m) => Key WarmUpResultData -> AvailabilityListWhere -> ConduitM () Measure (DB m) ()
loadReplicationWarmUpMeasuresWhere :: Key WarmUpResultData
-> AvailabilityListWhere -> ConduitM () Measure (DB m) ()
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
kExpRes (WarmUpMeasureWhere SqlExpr (Entity WarmUpMeasure)
-> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ()
where') = do
  let src :: ConduitT
  () (Entity WarmUpMeasure, Entity WarmUpResultStep) (DB m) ()
src =
        SqlQuery
  (SqlExpr (Entity WarmUpMeasure), SqlExpr (Entity WarmUpResultStep))
-> ConduitT
     () (Entity WarmUpMeasure, Entity WarmUpResultStep) (DB m) ()
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend,
 IsPersistBackend backend, PersistQueryRead backend,
 PersistStoreRead backend, PersistUniqueRead backend,
 MonadResource m) =>
SqlQuery a -> ConduitT () r (ReaderT backend m) ()
E.selectSource (SqlQuery
   (SqlExpr (Entity WarmUpMeasure), SqlExpr (Entity WarmUpResultStep))
 -> ConduitT
      () (Entity WarmUpMeasure, Entity WarmUpResultStep) (DB m) ())
-> SqlQuery
     (SqlExpr (Entity WarmUpMeasure), SqlExpr (Entity WarmUpResultStep))
-> ConduitT
     () (Entity WarmUpMeasure, Entity WarmUpResultStep) (DB m) ()
forall a b. (a -> b) -> a -> b
$
        ((SqlExpr (Entity WarmUpMeasure),
  SqlExpr (Entity WarmUpResultStep))
 -> SqlQuery
      (SqlExpr (Entity WarmUpMeasure),
       SqlExpr (Entity WarmUpResultStep)))
-> SqlQuery
     (SqlExpr (Entity WarmUpMeasure), SqlExpr (Entity WarmUpResultStep))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity WarmUpMeasure),
   SqlExpr (Entity WarmUpResultStep))
  -> SqlQuery
       (SqlExpr (Entity WarmUpMeasure),
        SqlExpr (Entity WarmUpResultStep)))
 -> SqlQuery
      (SqlExpr (Entity WarmUpMeasure),
       SqlExpr (Entity WarmUpResultStep)))
-> ((SqlExpr (Entity WarmUpMeasure),
     SqlExpr (Entity WarmUpResultStep))
    -> SqlQuery
         (SqlExpr (Entity WarmUpMeasure),
          SqlExpr (Entity WarmUpResultStep)))
-> SqlQuery
     (SqlExpr (Entity WarmUpMeasure), SqlExpr (Entity WarmUpResultStep))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity WarmUpMeasure)
warmUpM, SqlExpr (Entity WarmUpResultStep)
warmUpRS) -> do
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpMeasure)
warmUpM SqlExpr (Entity WarmUpMeasure)
-> EntityField WarmUpMeasure (Key WarmUpMeasure)
-> SqlExpr (Value (Key WarmUpMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpMeasure (Key WarmUpMeasure)
forall typ.
(typ ~ Key WarmUpMeasure) =>
EntityField WarmUpMeasure typ
WarmUpMeasureId SqlExpr (Value (Key WarmUpMeasure))
-> SqlExpr (Value (Key WarmUpMeasure)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity WarmUpResultStep)
warmUpRS SqlExpr (Entity WarmUpResultStep)
-> EntityField WarmUpResultStep (Key WarmUpMeasure)
-> SqlExpr (Value (Key WarmUpMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpResultStep (Key WarmUpMeasure)
forall typ.
(typ ~ Key WarmUpMeasure) =>
EntityField WarmUpResultStep typ
WarmUpResultStepMeasure)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpMeasure)
warmUpM SqlExpr (Entity WarmUpMeasure)
-> EntityField WarmUpMeasure (Key WarmUpResultData)
-> SqlExpr (Value (Key WarmUpResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpMeasure (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpMeasure typ
WarmUpMeasureRepResult SqlExpr (Value (Key WarmUpResultData))
-> SqlExpr (Value (Key WarmUpResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key WarmUpResultData -> SqlExpr (Value (Key WarmUpResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key WarmUpResultData
kExpRes)
          SqlExpr (Entity WarmUpMeasure)
-> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ()
where' SqlExpr (Entity WarmUpMeasure)
warmUpM SqlExpr (Entity WarmUpResultStep)
warmUpRS
          [SqlExpr OrderBy] -> SqlQuery ()
E.orderBy [SqlExpr (Value Int) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity WarmUpMeasure)
warmUpM SqlExpr (Entity WarmUpMeasure)
-> EntityField WarmUpMeasure Int -> SqlExpr (Value Int)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpMeasure Int
forall typ. (typ ~ Int) => EntityField WarmUpMeasure typ
WarmUpMeasurePeriod)]
          (SqlExpr (Entity WarmUpMeasure), SqlExpr (Entity WarmUpResultStep))
-> SqlQuery
     (SqlExpr (Entity WarmUpMeasure), SqlExpr (Entity WarmUpResultStep))
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity WarmUpMeasure)
warmUpM, SqlExpr (Entity WarmUpResultStep)
warmUpRS)
  ConduitT
  () (Entity WarmUpMeasure, Entity WarmUpResultStep) (DB m) ()
src ConduitT
  () (Entity WarmUpMeasure, Entity WarmUpResultStep) (DB m) ()
-> ConduitM
     (Entity WarmUpMeasure, Entity WarmUpResultStep) Measure (DB m) ()
-> ConduitM () Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ((Entity WarmUpMeasure, Entity WarmUpResultStep) -> Measure)
-> ConduitM
     (Entity WarmUpMeasure, Entity WarmUpResultStep) Measure (DB m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (Entity WarmUpMeasure, Entity WarmUpResultStep) -> Measure
mkMeasure ConduitM
  (Entity WarmUpMeasure, Entity WarmUpResultStep) Measure (DB m) ()
-> ConduitM Measure Measure (DB m) ()
-> ConduitM
     (Entity WarmUpMeasure, Entity WarmUpResultStep) Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| (Measure -> Measure -> Bool)
-> ConduitT Measure [Measure] (DB m) ()
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> ConduitT a [a] m ()
CL.groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Measure -> Int) -> Measure -> Measure -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Int Measure Int -> Measure -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Measure Int
Lens' Measure Int
measurePeriod) ConduitT Measure [Measure] (DB m) ()
-> ConduitM [Measure] Measure (DB m) ()
-> ConduitM Measure Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ([Measure] -> Measure) -> ConduitM [Measure] Measure (DB m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC [Measure] -> Measure
combineMeasures
  where
    mkMeasure :: (Entity WarmUpMeasure, Entity WarmUpResultStep) -> Measure
mkMeasure (Entity Key WarmUpMeasure
_ (WarmUpMeasure Key WarmUpResultData
_ Int
p), Entity Key WarmUpResultStep
_ (WarmUpResultStep Key WarmUpMeasure
_ Text
n Maybe Double
x Double
y)) = Int -> [StepResult] -> Measure
Measure Int
p [Text -> Maybe Double -> Double -> StepResult
StepResult Text
n Maybe Double
x Double
y]
    combineMeasures :: [Measure] -> Measure
combineMeasures xs :: [Measure]
xs@(Measure Int
p [StepResult]
_:[Measure]
_) = Int -> [StepResult] -> Measure
Measure Int
p ((Measure -> [StepResult]) -> [Measure] -> [StepResult]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Getting [StepResult] Measure [StepResult]
-> Measure -> [StepResult]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [StepResult] Measure [StepResult]
Lens' Measure [StepResult]
measureResults) [Measure]
xs)
    combineMeasures [Measure]
_                  = [Char] -> Measure
forall a. HasCallStack => [Char] -> a
error [Char]
"not possible"
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
kExpRes AvailabilityListWhere
GetAll = Key WarmUpResultData
-> AvailabilityListWhere -> ConduitM () Measure (DB m) ()
forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData
-> AvailabilityListWhere -> ConduitM () Measure (DB m) ()
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
kExpRes ((SqlExpr (Entity WarmUpMeasure)
 -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
-> AvailabilityListWhere
WarmUpMeasureWhere (\SqlExpr (Entity WarmUpMeasure)
_ SqlExpr (Entity WarmUpResultStep)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
_ AvailabilityListWhere
where' = [Char] -> ConduitM () Measure (DB m) ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ConduitM () Measure (DB m) ())
-> [Char] -> ConduitM () Measure (DB m) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepMeasuresWhere was expected"

loadReplicationWarmUpAggregateWhere :: (MonadIO m) => Key WarmUpResultData -> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReplicationWarmUpAggregateWhere :: Key WarmUpResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReplicationWarmUpAggregateWhere Key WarmUpResultData
kExpRes AggregateFunction
agg (WarmUpMeasureWhere SqlExpr (Entity WarmUpMeasure)
-> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ()
where') =
  ([Value (Maybe Double)] -> Double)
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
-> DB m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double)
-> ([Value (Maybe Double)] -> Maybe Double)
-> [Value (Maybe Double)]
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value (Maybe Double) -> Maybe Double
forall a. Value a -> a
E.unValue (Value (Maybe Double) -> Maybe Double)
-> ([Value (Maybe Double)] -> Value (Maybe Double))
-> [Value (Maybe Double)]
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value (Maybe Double)] -> Value (Maybe Double)
forall a. [a] -> a
head) (ReaderT SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
 -> DB m Double)
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
-> DB m Double
forall a b. (a -> b) -> a -> b
$
  SqlQuery (SqlExpr (Value (Maybe Double)))
-> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)]
forall a r (m :: * -> *).
(SqlSelect a r, MonadIO m) =>
SqlQuery a -> SqlReadT m [r]
E.select (SqlQuery (SqlExpr (Value (Maybe Double)))
 -> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)])
-> SqlQuery (SqlExpr (Value (Maybe Double)))
-> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)]
forall a b. (a -> b) -> a -> b
$
  ((SqlExpr (Entity WarmUpMeasure),
  SqlExpr (Entity WarmUpResultStep))
 -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity WarmUpMeasure),
   SqlExpr (Entity WarmUpResultStep))
  -> SqlQuery (SqlExpr (Value (Maybe Double))))
 -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> ((SqlExpr (Entity WarmUpMeasure),
     SqlExpr (Entity WarmUpResultStep))
    -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity WarmUpMeasure)
warmUpM, SqlExpr (Entity WarmUpResultStep)
warmUpRS) -> do
    SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpMeasure)
warmUpM SqlExpr (Entity WarmUpMeasure)
-> EntityField WarmUpMeasure (Key WarmUpMeasure)
-> SqlExpr (Value (Key WarmUpMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpMeasure (Key WarmUpMeasure)
forall typ.
(typ ~ Key WarmUpMeasure) =>
EntityField WarmUpMeasure typ
WarmUpMeasureId SqlExpr (Value (Key WarmUpMeasure))
-> SqlExpr (Value (Key WarmUpMeasure)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity WarmUpResultStep)
warmUpRS SqlExpr (Entity WarmUpResultStep)
-> EntityField WarmUpResultStep (Key WarmUpMeasure)
-> SqlExpr (Value (Key WarmUpMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpResultStep (Key WarmUpMeasure)
forall typ.
(typ ~ Key WarmUpMeasure) =>
EntityField WarmUpResultStep typ
WarmUpResultStepMeasure)
    SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpMeasure)
warmUpM SqlExpr (Entity WarmUpMeasure)
-> EntityField WarmUpMeasure (Key WarmUpResultData)
-> SqlExpr (Value (Key WarmUpResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpMeasure (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpMeasure typ
WarmUpMeasureRepResult SqlExpr (Value (Key WarmUpResultData))
-> SqlExpr (Value (Key WarmUpResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key WarmUpResultData -> SqlExpr (Value (Key WarmUpResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key WarmUpResultData
kExpRes)
    SqlExpr (Entity WarmUpMeasure)
-> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ()
where' SqlExpr (Entity WarmUpMeasure)
warmUpM SqlExpr (Entity WarmUpResultStep)
warmUpRS
    SqlExpr (Value (Maybe Double))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall (m :: * -> *) a. Monad m => a -> m a
return (AggregateFunction
agg AggregateFunction -> AggregateFunction
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity WarmUpResultStep)
warmUpRS SqlExpr (Entity WarmUpResultStep)
-> EntityField WarmUpResultStep Double -> SqlExpr (Value Double)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField WarmUpResultStep Double
forall typ. (typ ~ Double) => EntityField WarmUpResultStep typ
WarmUpResultStepYValue)
loadReplicationWarmUpAggregateWhere Key WarmUpResultData
kExpRes AggregateFunction
agg AvailabilityListWhere
GetAll = Key WarmUpResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReplicationWarmUpAggregateWhere Key WarmUpResultData
kExpRes AggregateFunction
agg ((SqlExpr (Entity WarmUpMeasure)
 -> SqlExpr (Entity WarmUpResultStep) -> SqlQuery ())
-> AvailabilityListWhere
WarmUpMeasureWhere (\SqlExpr (Entity WarmUpMeasure)
_ SqlExpr (Entity WarmUpResultStep)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationWarmUpAggregateWhere Key WarmUpResultData
_ AggregateFunction
_ AvailabilityListWhere
where' = [Char] -> DB m Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> DB m Double) -> [Char] -> DB m Double
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where loadReplicationWarmUpAggregateWhere was expected"


loadReplicationInputCount :: (MonadIO m) => Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationInputCount :: Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationInputCount Key RepResultData
kExpRes = [Filter RepInput] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [EntityField RepInput (Key RepResultData)
forall typ. (typ ~ Key RepResultData) => EntityField RepInput typ
RepInputRepResult EntityField RepInput (Key RepResultData)
-> Key RepResultData -> Filter RepInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
kExpRes]

loadReplicationInputWhere :: (ExperimentDef a, MonadIO m) => Key RepResultData -> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationInputWhere :: Key RepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationInputWhere Key RepResultData
kExpRes (RepInputWhere SqlExpr (Entity RepInput)
-> SqlExpr (Entity RepInputValue) -> SqlQuery ()
where') = do
  let src :: ConduitT () (Entity RepInput, Entity RepInputValue) (DB m) ()
src =
       SqlQuery
  (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
-> ConduitT () (Entity RepInput, Entity RepInputValue) (DB m) ()
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend,
 IsPersistBackend backend, PersistQueryRead backend,
 PersistStoreRead backend, PersistUniqueRead backend,
 MonadResource m) =>
SqlQuery a -> ConduitT () r (ReaderT backend m) ()
E.selectSource (SqlQuery
   (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
 -> ConduitT () (Entity RepInput, Entity RepInputValue) (DB m) ())
-> SqlQuery
     (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
-> ConduitT () (Entity RepInput, Entity RepInputValue) (DB m) ()
forall a b. (a -> b) -> a -> b
$
       ((SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
 -> SqlQuery
      (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue)))
-> SqlQuery
     (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
  -> SqlQuery
       (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue)))
 -> SqlQuery
      (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue)))
-> ((SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
    -> SqlQuery
         (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue)))
-> SqlQuery
     (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity RepInput)
repI, SqlExpr (Entity RepInputValue)
repIV) -> do
         SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepInput)
repI SqlExpr (Entity RepInput)
-> EntityField RepInput (Key RepInput)
-> SqlExpr (Value (Key RepInput))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepInput (Key RepInput)
forall typ. (typ ~ Key RepInput) => EntityField RepInput typ
RepInputId SqlExpr (Value (Key RepInput))
-> SqlExpr (Value (Key RepInput)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity RepInputValue)
repIV SqlExpr (Entity RepInputValue)
-> EntityField RepInputValue (Key RepInput)
-> SqlExpr (Value (Key RepInput))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepInputValue (Key RepInput)
forall typ. (typ ~ Key RepInput) => EntityField RepInputValue typ
RepInputValueRepInput)
         SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepInput)
repI SqlExpr (Entity RepInput)
-> EntityField RepInput (Key RepResultData)
-> SqlExpr (Value (Key RepResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepInput (Key RepResultData)
forall typ. (typ ~ Key RepResultData) => EntityField RepInput typ
RepInputRepResult SqlExpr (Value (Key RepResultData))
-> SqlExpr (Value (Key RepResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key RepResultData -> SqlExpr (Value (Key RepResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key RepResultData
kExpRes)
         SqlExpr (Entity RepInput)
-> SqlExpr (Entity RepInputValue) -> SqlQuery ()
where' SqlExpr (Entity RepInput)
repI SqlExpr (Entity RepInputValue)
repIV
         (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
-> SqlQuery
     (SqlExpr (Entity RepInput), SqlExpr (Entity RepInputValue))
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity RepInput)
repI, SqlExpr (Entity RepInputValue)
repIV)
  ConduitT () (Entity RepInput, Entity RepInputValue) (DB m) ()
src ConduitT () (Entity RepInput, Entity RepInputValue) (DB m) ()
-> ConduitM
     (Entity RepInput, Entity RepInputValue) (Input a) (DB m) ()
-> ConduitT () (Input a) (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ((Entity RepInput, Entity RepInputValue)
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe (Input a)))
-> ConduitT
     (Entity RepInput, Entity RepInputValue) (Maybe (Input a)) (DB m) ()
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapMC (Entity RepInput, Entity RepInputValue)
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe (Input a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize (InputValue a)) =>
(Entity RepInput, Entity RepInputValue) -> m (Maybe (Input a))
mkInput ConduitT
  (Entity RepInput, Entity RepInputValue) (Maybe (Input a)) (DB m) ()
-> ConduitM (Maybe (Input a)) (Input a) (DB m) ()
-> ConduitM
     (Entity RepInput, Entity RepInputValue) (Input a) (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| [Maybe (Input a)] -> ConduitM (Maybe (Input a)) (Input a) (DB m) ()
forall (m :: * -> *) o.
Monad m =>
[Maybe o] -> ConduitT (Maybe o) o m ()
sequenceC []
  -- sequence <$> mapM mkInput res
  where
    mkInput :: (Entity RepInput, Entity RepInputValue) -> m (Maybe (Input a))
mkInput (Entity Key RepInput
_ (RepInput Key RepResultData
_ Int
p), Entity Key RepInputValue
_ (RepInputValue Key RepInput
_ ByteString
v)) = do
      Maybe (InputValue a)
v' <- Text -> ByteString -> m (Maybe (InputValue a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"eval input value" ByteString
v
      Maybe (Input a) -> m (Maybe (Input a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Input a) -> m (Maybe (Input a)))
-> Maybe (Input a) -> m (Maybe (Input a))
forall a b. (a -> b) -> a -> b
$ Int -> InputValue a -> Input a
forall a. Int -> InputValue a -> Input a
Input Int
p (InputValue a -> Input a)
-> Maybe (InputValue a) -> Maybe (Input a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputValue a)
v'
loadReplicationInputWhere Key RepResultData
kExpRes AvailabilityListWhere
GetAll = Key RepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
Key RepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationInputWhere Key RepResultData
kExpRes ((SqlExpr (Entity RepInput)
 -> SqlExpr (Entity RepInputValue) -> SqlQuery ())
-> AvailabilityListWhere
RepInputWhere (\SqlExpr (Entity RepInput)
_ SqlExpr (Entity RepInputValue)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationInputWhere Key RepResultData
_ AvailabilityListWhere
where' = [Char] -> ConduitT () (Input a) (DB m) ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ConduitT () (Input a) (DB m) ())
-> [Char] -> ConduitT () (Input a) (DB m) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where RepInputWhere was expected"


loadReplicationMeasuresCount :: (MonadIO m) => Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationMeasuresCount :: Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationMeasuresCount Key RepResultData
kExpRes = [Filter RepMeasure] -> ReaderT SqlBackend m Int
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [EntityField RepMeasure (Key RepResultData)
forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult EntityField RepMeasure (Key RepResultData)
-> Key RepResultData -> Filter RepMeasure
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
kExpRes]


loadReplicationMeasuresWhere :: (MonadIO m) => Key RepResultData -> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadReplicationMeasuresWhere :: Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadReplicationMeasuresWhere Key RepResultData
kExpRes (RepMeasureWhere SqlExpr (Entity RepMeasure)
-> SqlExpr (Entity RepResultStep) -> SqlQuery ()
where') = do
  let src :: ConduitT () (Entity RepMeasure, Entity RepResultStep) (DB m) ()
src =
        SqlQuery
  (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
-> ConduitT () (Entity RepMeasure, Entity RepResultStep) (DB m) ()
forall a r backend (m :: * -> *).
(SqlSelect a r, BackendCompatible SqlBackend backend,
 IsPersistBackend backend, PersistQueryRead backend,
 PersistStoreRead backend, PersistUniqueRead backend,
 MonadResource m) =>
SqlQuery a -> ConduitT () r (ReaderT backend m) ()
E.selectSource (SqlQuery
   (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
 -> ConduitT () (Entity RepMeasure, Entity RepResultStep) (DB m) ())
-> SqlQuery
     (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
-> ConduitT () (Entity RepMeasure, Entity RepResultStep) (DB m) ()
forall a b. (a -> b) -> a -> b
$
        ((SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
 -> SqlQuery
      (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep)))
-> SqlQuery
     (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
  -> SqlQuery
       (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep)))
 -> SqlQuery
      (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep)))
-> ((SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
    -> SqlQuery
         (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep)))
-> SqlQuery
     (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity RepMeasure)
repM, SqlExpr (Entity RepResultStep)
repRS) -> do
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
repM SqlExpr (Entity RepMeasure)
-> EntityField RepMeasure (Key RepMeasure)
-> SqlExpr (Value (Key RepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepMeasure (Key RepMeasure)
forall typ. (typ ~ Key RepMeasure) => EntityField RepMeasure typ
RepMeasureId SqlExpr (Value (Key RepMeasure))
-> SqlExpr (Value (Key RepMeasure)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity RepResultStep)
repRS SqlExpr (Entity RepResultStep)
-> EntityField RepResultStep (Key RepMeasure)
-> SqlExpr (Value (Key RepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepResultStep (Key RepMeasure)
forall typ. (typ ~ Key RepMeasure) => EntityField RepResultStep typ
RepResultStepMeasure)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
repM SqlExpr (Entity RepMeasure)
-> EntityField RepMeasure (Key RepResultData)
-> SqlExpr (Value (Key RepResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepMeasure (Key RepResultData)
forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult SqlExpr (Value (Key RepResultData))
-> SqlExpr (Value (Key RepResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key RepResultData -> SqlExpr (Value (Key RepResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key RepResultData
kExpRes)
          SqlExpr (Entity RepMeasure)
-> SqlExpr (Entity RepResultStep) -> SqlQuery ()
where' SqlExpr (Entity RepMeasure)
repM SqlExpr (Entity RepResultStep)
repRS
          [SqlExpr OrderBy] -> SqlQuery ()
E.orderBy [SqlExpr (Value Int) -> SqlExpr OrderBy
forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity RepMeasure)
repM SqlExpr (Entity RepMeasure)
-> EntityField RepMeasure Int -> SqlExpr (Value Int)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepMeasure Int
forall typ. (typ ~ Int) => EntityField RepMeasure typ
RepMeasurePeriod)]
          (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
-> SqlQuery
     (SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
forall (m :: * -> *) a. Monad m => a -> m a
return (SqlExpr (Entity RepMeasure)
repM, SqlExpr (Entity RepResultStep)
repRS)
  ConduitT () (Entity RepMeasure, Entity RepResultStep) (DB m) ()
src ConduitT () (Entity RepMeasure, Entity RepResultStep) (DB m) ()
-> ConduitM
     (Entity RepMeasure, Entity RepResultStep) Measure (DB m) ()
-> ConduitT () Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ((Entity RepMeasure, Entity RepResultStep) -> Measure)
-> ConduitM
     (Entity RepMeasure, Entity RepResultStep) Measure (DB m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (Entity RepMeasure, Entity RepResultStep) -> Measure
mkMeasure ConduitM
  (Entity RepMeasure, Entity RepResultStep) Measure (DB m) ()
-> ConduitM Measure Measure (DB m) ()
-> ConduitM
     (Entity RepMeasure, Entity RepResultStep) Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| (Measure -> Measure -> Bool)
-> ConduitT Measure [Measure] (DB m) ()
forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> ConduitT a [a] m ()
CL.groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> (Measure -> Int) -> Measure -> Measure -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Int Measure Int -> Measure -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Measure Int
Lens' Measure Int
measurePeriod) ConduitT Measure [Measure] (DB m) ()
-> ConduitM [Measure] Measure (DB m) ()
-> ConduitM Measure Measure (DB m) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
C..| ([Measure] -> Measure) -> ConduitM [Measure] Measure (DB m) ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC [Measure] -> Measure
combineMeasures
  where
    mkMeasure :: (Entity RepMeasure, Entity RepResultStep) -> Measure
mkMeasure (Entity Key RepMeasure
_ (RepMeasure Key RepResultData
_ Int
p), Entity Key RepResultStep
_ (RepResultStep Key RepMeasure
_ Text
n Maybe Double
x Double
y)) = Int -> [StepResult] -> Measure
Measure Int
p [Text -> Maybe Double -> Double -> StepResult
StepResult Text
n Maybe Double
x Double
y]
    combineMeasures :: [Measure] -> Measure
combineMeasures xs :: [Measure]
xs@(Measure Int
p [StepResult]
_:[Measure]
_) = Int -> [StepResult] -> Measure
Measure Int
p ((Measure -> [StepResult]) -> [Measure] -> [StepResult]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Getting [StepResult] Measure [StepResult]
-> Measure -> [StepResult]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [StepResult] Measure [StepResult]
Lens' Measure [StepResult]
measureResults) [Measure]
xs)
    combineMeasures [Measure]
_                  = [Char] -> Measure
forall a. HasCallStack => [Char] -> a
error [Char]
"not possible"
loadReplicationMeasuresWhere Key RepResultData
kExpRes AvailabilityListWhere
GetAll = Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
forall (m :: * -> *).
MonadIO m =>
Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadReplicationMeasuresWhere Key RepResultData
kExpRes ((SqlExpr (Entity RepMeasure)
 -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
RepMeasureWhere (\SqlExpr (Entity RepMeasure)
_ SqlExpr (Entity RepResultStep)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationMeasuresWhere Key RepResultData
_ AvailabilityListWhere
where' = [Char] -> ConduitT () Measure (DB m) ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> ConduitT () Measure (DB m) ())
-> [Char] -> ConduitT () Measure (DB m) ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where RepMeasuresWhere was expected"


loadReparationAggregateWhere :: (MonadIO m) => Key RepResultData -> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReparationAggregateWhere :: Key RepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReparationAggregateWhere Key RepResultData
kExpRes AggregateFunction
agg (RepMeasureWhere SqlExpr (Entity RepMeasure)
-> SqlExpr (Entity RepResultStep) -> SqlQuery ()
where') =
  ([Value (Maybe Double)] -> Double)
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
-> DB m Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double)
-> ([Value (Maybe Double)] -> Maybe Double)
-> [Value (Maybe Double)]
-> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value (Maybe Double) -> Maybe Double
forall a. Value a -> a
E.unValue (Value (Maybe Double) -> Maybe Double)
-> ([Value (Maybe Double)] -> Value (Maybe Double))
-> [Value (Maybe Double)]
-> Maybe Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value (Maybe Double)] -> Value (Maybe Double)
forall a. [a] -> a
head) (ReaderT SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
 -> DB m Double)
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [Value (Maybe Double)]
-> DB m Double
forall a b. (a -> b) -> a -> b
$
  SqlQuery (SqlExpr (Value (Maybe Double)))
-> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)]
forall a r (m :: * -> *).
(SqlSelect a r, MonadIO m) =>
SqlQuery a -> SqlReadT m [r]
E.select (SqlQuery (SqlExpr (Value (Maybe Double)))
 -> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)])
-> SqlQuery (SqlExpr (Value (Maybe Double)))
-> SqlReadT (LoggingT (ResourceT m)) [Value (Maybe Double)]
forall a b. (a -> b) -> a -> b
$
  ((SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
 -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from (((SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
  -> SqlQuery (SqlExpr (Value (Maybe Double))))
 -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> ((SqlExpr (Entity RepMeasure), SqlExpr (Entity RepResultStep))
    -> SqlQuery (SqlExpr (Value (Maybe Double))))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall a b. (a -> b) -> a -> b
$ \(SqlExpr (Entity RepMeasure)
repM, SqlExpr (Entity RepResultStep)
repRS) -> do
    SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
repM SqlExpr (Entity RepMeasure)
-> EntityField RepMeasure (Key RepMeasure)
-> SqlExpr (Value (Key RepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepMeasure (Key RepMeasure)
forall typ. (typ ~ Key RepMeasure) => EntityField RepMeasure typ
RepMeasureId SqlExpr (Value (Key RepMeasure))
-> SqlExpr (Value (Key RepMeasure)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity RepResultStep)
repRS SqlExpr (Entity RepResultStep)
-> EntityField RepResultStep (Key RepMeasure)
-> SqlExpr (Value (Key RepMeasure))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepResultStep (Key RepMeasure)
forall typ. (typ ~ Key RepMeasure) => EntityField RepResultStep typ
RepResultStepMeasure)
    SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
repM SqlExpr (Entity RepMeasure)
-> EntityField RepMeasure (Key RepResultData)
-> SqlExpr (Value (Key RepResultData))
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepMeasure (Key RepResultData)
forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult SqlExpr (Value (Key RepResultData))
-> SqlExpr (Value (Key RepResultData)) -> SqlExpr (Value Bool)
forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. Key RepResultData -> SqlExpr (Value (Key RepResultData))
forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key RepResultData
kExpRes)
    SqlExpr (Entity RepMeasure)
-> SqlExpr (Entity RepResultStep) -> SqlQuery ()
where' SqlExpr (Entity RepMeasure)
repM SqlExpr (Entity RepResultStep)
repRS
    SqlExpr (Value (Maybe Double))
-> SqlQuery (SqlExpr (Value (Maybe Double)))
forall (m :: * -> *) a. Monad m => a -> m a
return (AggregateFunction
agg AggregateFunction -> AggregateFunction
forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity RepResultStep)
repRS SqlExpr (Entity RepResultStep)
-> EntityField RepResultStep Double -> SqlExpr (Value Double)
forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. EntityField RepResultStep Double
forall typ. (typ ~ Double) => EntityField RepResultStep typ
RepResultStepYValue)
loadReparationAggregateWhere Key RepResultData
kExpRes AggregateFunction
agg AvailabilityListWhere
GetAll = Key RepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
forall (m :: * -> *).
MonadIO m =>
Key RepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReparationAggregateWhere Key RepResultData
kExpRes AggregateFunction
agg ((SqlExpr (Entity RepMeasure)
 -> SqlExpr (Entity RepResultStep) -> SqlQuery ())
-> AvailabilityListWhere
RepMeasureWhere (\SqlExpr (Entity RepMeasure)
_ SqlExpr (Entity RepResultStep)
_ -> () -> SqlQuery ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReparationAggregateWhere Key RepResultData
_ AggregateFunction
_ AvailabilityListWhere
where' = [Char] -> DB m Double
forall a. HasCallStack => [Char] -> a
error ([Char] -> DB m Double) -> [Char] -> DB m Double
forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ AvailabilityListWhere -> [Char]
forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where RepAggregateWhere was expected"


getOrCreateExps :: forall a . (ExperimentDef a) => ExperimentSetting -> InputState a -> a -> DB (ExpM a) (Entity Exps)
getOrCreateExps :: ExperimentSetting -> InputState a -> a -> DB (ExpM a) (Entity Exps)
getOrCreateExps ExperimentSetting
setup InputState a
initInpSt a
initSt = do
  let name :: Text
name = Getting Text ExperimentSetting Text -> ExperimentSetting -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ExperimentSetting Text
Lens' ExperimentSetting Text
experimentBaseName ExperimentSetting
setup
  [Entity Exps]
expsList <- [Filter Exps]
-> [SelectOpt Exps]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity Exps]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField Exps Text
forall typ. (typ ~ Text) => EntityField Exps typ
ExpsName EntityField Exps Text -> Text -> Filter Exps
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Text
name] []
  [[ExpsInfoParam]]
expsInfoParams <- ([Entity ExpsInfoParam] -> [ExpsInfoParam])
-> [[Entity ExpsInfoParam]] -> [[ExpsInfoParam]]
forall a b. (a -> b) -> [a] -> [b]
map ((Entity ExpsInfoParam -> ExpsInfoParam)
-> [Entity ExpsInfoParam] -> [ExpsInfoParam]
forall a b. (a -> b) -> [a] -> [b]
map Entity ExpsInfoParam -> ExpsInfoParam
forall record. Entity record -> record
entityVal) ([[Entity ExpsInfoParam]] -> [[ExpsInfoParam]])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[Entity ExpsInfoParam]]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[ExpsInfoParam]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Entity Exps
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity ExpsInfoParam])
-> [Entity Exps]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[Entity ExpsInfoParam]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Entity Key Exps
e Exps
_) -> [Filter ExpsInfoParam]
-> [SelectOpt ExpsInfoParam]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity ExpsInfoParam]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField ExpsInfoParam (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField ExpsInfoParam typ
ExpsInfoParamExps EntityField ExpsInfoParam (Key Exps)
-> Key Exps -> Filter ExpsInfoParam
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exps
e] []) [Entity Exps]
expsList
  let expsList' :: [Entity Exps]
expsList' = ((Entity Exps, [ExpsInfoParam]) -> Entity Exps)
-> [(Entity Exps, [ExpsInfoParam])] -> [Entity Exps]
forall a b. (a -> b) -> [a] -> [b]
map (Entity Exps, [ExpsInfoParam]) -> Entity Exps
forall a b. (a, b) -> a
fst ([(Entity Exps, [ExpsInfoParam])] -> [Entity Exps])
-> [(Entity Exps, [ExpsInfoParam])] -> [Entity Exps]
forall a b. (a -> b) -> a -> b
$ ((Entity Exps, [ExpsInfoParam]) -> Bool)
-> [(Entity Exps, [ExpsInfoParam])]
-> [(Entity Exps, [ExpsInfoParam])]
forall a. (a -> Bool) -> [a] -> [a]
filter ((\[ExpsInfoParam]
xs -> [ExperimentInfoParameter] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExperimentInfoParameter]
infoParams Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= [ExpsInfoParam] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpsInfoParam]
xs Bool -> Bool -> Bool
&& (ExpsInfoParam -> Bool) -> [ExpsInfoParam] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ExpsInfoParam -> Bool
matchesExpsInfoParam [ExpsInfoParam]
xs) ([ExpsInfoParam] -> Bool)
-> ((Entity Exps, [ExpsInfoParam]) -> [ExpsInfoParam])
-> (Entity Exps, [ExpsInfoParam])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity Exps, [ExpsInfoParam]) -> [ExpsInfoParam]
forall a b. (a, b) -> b
snd) ([Entity Exps]
-> [[ExpsInfoParam]] -> [(Entity Exps, [ExpsInfoParam])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Entity Exps]
expsList [[ExpsInfoParam]]
expsInfoParams)
  Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Entity Exps] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Entity Exps]
expsList') (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"No experiment with same Experiment Info Parameters found!"
  [Entity Exps]
exps <-
    (Entity Exps
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Bool)
-> [Entity Exps]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity Exps]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM
      (\(Entity Key Exps
_ (Exps Text
_ UTCTime
_ Maybe UTCTime
_ ByteString
s ByteString
iS)) -> do
         Either [Char] a
serSt <- LoggingT (ResourceT (ExpM a)) (Either [Char] a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Either [Char] a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Either [Char] a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Either [Char] a))
-> LoggingT (ResourceT (ExpM a)) (Either [Char] a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Either [Char] a)
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) (Either [Char] a)
-> LoggingT (ResourceT (ExpM a)) (Either [Char] a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Either [Char] a)
 -> LoggingT (ResourceT (ExpM a)) (Either [Char] a))
-> ResourceT (ExpM a) (Either [Char] a)
-> LoggingT (ResourceT (ExpM a)) (Either [Char] a)
forall a b. (a -> b) -> a -> b
$ ExpM a (Either [Char] a) -> ResourceT (ExpM a) (Either [Char] a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Either [Char] a) -> ResourceT (ExpM a) (Either [Char] a))
-> ExpM a (Either [Char] a) -> ResourceT (ExpM a) (Either [Char] a)
forall a b. (a -> b) -> a -> b
$ Either [Char] (ExpM a a) -> ExpM a (Either [Char] a)
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (Either [Char] (ExpM a a) -> ExpM a (Either [Char] a))
-> Either [Char] (ExpM a a) -> ExpM a (Either [Char] a)
forall a b. (a -> b) -> a -> b
$ Serializable a -> ExpM a a
forall a. ExperimentDef a => Serializable a -> ExpM a a
deserialisable (Serializable a -> ExpM a a)
-> Either [Char] (Serializable a) -> Either [Char] (ExpM a a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get (Serializable a)
-> ByteString -> Either [Char] (Serializable a)
forall a. Get a -> ByteString -> Either [Char] a
runGet Get (Serializable a)
forall t. Serialize t => Get t
S.get ByteString
s
         let other :: Either [Char] (a, InputState a)
other = (,) (a -> InputState a -> (a, InputState a))
-> Either [Char] a
-> Either [Char] (InputState a -> (a, InputState a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] a
serSt Either [Char] (InputState a -> (a, InputState a))
-> Either [Char] (InputState a) -> Either [Char] (a, InputState a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Get (InputState a) -> ByteString -> Either [Char] (InputState a)
forall a. Get a -> ByteString -> Either [Char] a
runGet Get (InputState a)
forall t. Serialize t => Get t
S.get ByteString
iS
         Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Either [Char] (a, InputState a) -> Bool
forall a b. Either a b -> Bool
isLeft Either [Char] (a, InputState a)
other) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Could not deserialise experiment with same name"
         Bool -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Bool)
-> Bool -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either [Char] Bool -> Bool
forall p a. p -> Either a p -> p
fromEither Bool
False ((a, InputState a) -> (a, InputState a) -> Bool
forall a.
ExperimentDef a =>
(a, InputState a) -> (a, InputState a) -> Bool
equalExperiments (a
initSt, InputState a
initInpSt) ((a, InputState a) -> Bool)
-> Either [Char] (a, InputState a) -> Either [Char] Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] (a, InputState a)
other))
      [Entity Exps]
expsList'
  Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Entity Exps] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Entity Exps]
expsList') Bool -> Bool -> Bool
&& [Entity Exps] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Entity Exps]
exps) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Found experiments with same name, but the are different or not deserialisable!"
  [[Entity Param]]
params <- (Entity Exps
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity Param])
-> [Entity Exps]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[Entity Param]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Entity Exps
e -> [Filter Param]
-> [SelectOpt Param]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity Param]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField Param (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField Param typ
ParamExps EntityField Param (Key Exps) -> Key Exps -> Filter Param
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
e] [EntityField Param Text -> SelectOpt Param
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField Param Text
forall typ. (typ ~ Text) => EntityField Param typ
ParamName]) [Entity Exps]
exps
  let mkParamTpl :: Param -> Text
mkParamTpl (Param Key Exps
_ Text
n Maybe ByteString
_ Maybe ByteString
_) = Text
n
  let ~[Text]
myParams = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (ParameterSetup a -> Text) -> [ParameterSetup a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Param -> Text
mkParamTpl (Param -> Text)
-> (ParameterSetup a -> Param) -> ParameterSetup a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key Exps -> ParameterSetup a -> Param
forall a. Key Exps -> ParameterSetup a -> Param
convertParameterSetup (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey ([Entity Exps] -> Entity Exps
forall a. [a] -> a
head [Entity Exps]
exps))) (a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
initSt)
  case ((Entity Exps, [Entity Param]) -> Bool)
-> [(Entity Exps, [Entity Param])]
-> Maybe (Entity Exps, [Entity Param])
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (([Text] -> [Text] -> Bool
forall a. Eq a => a -> a -> Bool
== [Text]
myParams) ([Text] -> Bool)
-> ((Entity Exps, [Entity Param]) -> [Text])
-> (Entity Exps, [Entity Param])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort ([Text] -> [Text])
-> ((Entity Exps, [Entity Param]) -> [Text])
-> (Entity Exps, [Entity Param])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity Param -> Text) -> [Entity Param] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Param -> Text
mkParamTpl (Param -> Text) -> (Entity Param -> Param) -> Entity Param -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity Param -> Param
forall record. Entity record -> record
entityVal) ([Entity Param] -> [Text])
-> ((Entity Exps, [Entity Param]) -> [Entity Param])
-> (Entity Exps, [Entity Param])
-> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity Exps, [Entity Param]) -> [Entity Param]
forall a b. (a, b) -> b
snd) ([Entity Exps]
-> [[Entity Param]] -> [(Entity Exps, [Entity Param])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Entity Exps]
exps [[Entity Param]]
params) of
    Maybe (Entity Exps, [Entity Param])
Nothing -> do
      $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Starting new experiment..."
      UTCTime
time <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      !Serializable a
serInitSt <- LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Serializable a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Serializable a)
 -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a))
-> ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall a b. (a -> b) -> a -> b
$ a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable a
initSt
      Entity Exps
eExp <- Exps -> DB (ExpM a) (Entity Exps)
forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 MonadIO m) =>
e -> ReaderT backend m (Entity e)
insertEntity (Exps -> DB (ExpM a) (Entity Exps))
-> Exps -> DB (ExpM a) (Entity Exps)
forall a b. (a -> b) -> a -> b
$ Text
-> UTCTime -> Maybe UTCTime -> ByteString -> ByteString -> Exps
Exps Text
name UTCTime
time Maybe UTCTime
forall a. Maybe a
Nothing (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter (Serializable a)
forall t. Serialize t => Putter t
put Serializable a
serInitSt) (Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter (InputState a)
forall t. Serialize t => Putter t
put InputState a
initInpSt)
      ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
      ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsSetup)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsSetup)
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsSetup)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ ExpsSetup
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsSetup)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (ExpsSetup
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsSetup))
-> ExpsSetup
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsSetup)
forall a b. (a -> b) -> a -> b
$ Entity Exps -> ExpsSetup
mkExpSetup Entity Exps
eExp
      (ExperimentInfoParameter
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsInfoParam))
-> [ExperimentInfoParameter]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Key Exps
-> ExperimentInfoParameter
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsInfoParam)
forall (m :: * -> *) backend.
(MonadIO m, PersistStoreWrite backend,
 BaseBackend backend ~ SqlBackend) =>
Key Exps
-> ExperimentInfoParameter -> ReaderT backend m (Key ExpsInfoParam)
insertInfoParam (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp)) [ExperimentInfoParameter]
infoParams
      (ParameterSetup a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param))
-> [ParameterSetup a]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Key Exps
-> ParameterSetup a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param)
insertParam (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp)) (a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
initSt)
      Entity Exps -> DB (ExpM a) (Entity Exps)
forall (m :: * -> *) a. Monad m => a -> m a
return Entity Exps
eExp
    Just (Entity Exps
eExp, [Entity Param]
_) -> do
      $(Int
[Char]
LogLevel
[Char] -> Text
[Char] -> [Char] -> [Char] -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: [Char] -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Found experiment with same name and parameter settings. Continuing experiment ..."
      [ExpsInfoParam]
expInfoParams <- (Entity ExpsInfoParam -> ExpsInfoParam)
-> [Entity ExpsInfoParam] -> [ExpsInfoParam]
forall a b. (a -> b) -> [a] -> [b]
map Entity ExpsInfoParam -> ExpsInfoParam
forall record. Entity record -> record
entityVal ([Entity ExpsInfoParam] -> [ExpsInfoParam])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity ExpsInfoParam]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExpsInfoParam]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter ExpsInfoParam]
-> [SelectOpt ExpsInfoParam]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity ExpsInfoParam]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField ExpsInfoParam (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField ExpsInfoParam typ
ExpsInfoParamExps EntityField ExpsInfoParam (Key Exps)
-> Key Exps -> Filter ExpsInfoParam
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp] []
      (ExperimentInfoParameter
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsInfoParam))
-> [ExperimentInfoParameter]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Key Exps
-> ExperimentInfoParameter
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key ExpsInfoParam)
forall (m :: * -> *) backend.
(MonadIO m, PersistStoreWrite backend,
 BaseBackend backend ~ SqlBackend) =>
Key Exps
-> ExperimentInfoParameter -> ReaderT backend m (Key ExpsInfoParam)
insertInfoParam (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp)) ((ExperimentInfoParameter -> Bool)
-> [ExperimentInfoParameter] -> [ExperimentInfoParameter]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (ExpsInfoParam -> Text) -> [ExpsInfoParam] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Getting Text ExpsInfoParam Text -> ExpsInfoParam -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text ExpsInfoParam Text
forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> ExpsInfoParam -> f ExpsInfoParam
expsInfoParamName) [ExpsInfoParam]
expInfoParams) (Text -> Bool)
-> (ExperimentInfoParameter -> Text)
-> ExperimentInfoParameter
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExperimentInfoParameter -> Text
infoParameterName) [ExperimentInfoParameter]
infoParams)
      [ExpsSetup]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
putMany [Entity Exps -> ExpsSetup
mkExpSetup Entity Exps
eExp]
      Entity Exps -> DB (ExpM a) (Entity Exps)
forall (m :: * -> *) a. Monad m => a -> m a
return Entity Exps
eExp
  where
    mkExpSetup :: Entity Exps -> ExpsSetup
mkExpSetup Entity Exps
eExp =
      Key Exps
-> Int -> Int -> Int -> Int -> Int -> Maybe Int -> ExpsSetup
ExpsSetup
        (Entity Exps -> Key Exps
forall record. Entity record -> Key record
entityKey Entity Exps
eExp)
        (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting Int ExperimentSetting Int -> ExperimentSetting -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
experimentRepetitions ExperimentSetting
setup)
        (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting Int ExperimentSetting Int -> ExperimentSetting -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
preparationSteps ExperimentSetting
setup)
        (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting Int ExperimentSetting Int -> ExperimentSetting -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
evaluationWarmUpSteps ExperimentSetting
setup)
        (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting Int ExperimentSetting Int -> ExperimentSetting -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
evaluationSteps ExperimentSetting
setup)
        (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting Int ExperimentSetting Int -> ExperimentSetting -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
evaluationReplications ExperimentSetting
setup)
        (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe Int) ExperimentSetting (Maybe Int)
-> ExperimentSetting -> Maybe Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (Maybe Int) ExperimentSetting (Maybe Int)
Lens' ExperimentSetting (Maybe Int)
evaluationMaxStepsBetweenSaves ExperimentSetting
setup)
    insertInfoParam :: Key Exps
-> ExperimentInfoParameter -> ReaderT backend m (Key ExpsInfoParam)
insertInfoParam Key Exps
k (ExperimentInfoParameter Text
n b
v) = ExpsInfoParam -> ReaderT backend m (Key ExpsInfoParam)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (ExpsInfoParam -> ReaderT backend m (Key ExpsInfoParam))
-> ExpsInfoParam -> ReaderT backend m (Key ExpsInfoParam)
forall a b. (a -> b) -> a -> b
$ Key Exps -> Text -> ByteString -> ExpsInfoParam
ExpsInfoParam Key Exps
k Text
n (Put -> ByteString
S.runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter b
forall t. Serialize t => Putter t
S.put b
v)
    insertParam :: Key Exps -> ParameterSetup a -> DB (ExpM a) (Key Param)
    insertParam :: Key Exps
-> ParameterSetup a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param)
insertParam Key Exps
eExp (ParameterSetup Text
n b -> a -> a
_ a -> b
_ Maybe (b -> IO [b])
_ (Just (b
minVal, b
maxVal)) Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_) = Param
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Param
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param))
-> Param
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param)
forall a b. (a -> b) -> a -> b
$ Key Exps -> Text -> Maybe ByteString -> Maybe ByteString -> Param
Param Key Exps
eExp Text
n (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter b
forall t. Serialize t => Putter t
put b
minVal) (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut (Put -> ByteString) -> Put -> ByteString
forall a b. (a -> b) -> a -> b
$ Putter b
forall t. Serialize t => Putter t
put b
maxVal)
    insertParam Key Exps
eExp (ParameterSetup Text
n b -> a -> a
_ a -> b
_ Maybe (b -> IO [b])
_ Maybe (b, b)
Nothing Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_) = Param
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Param
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param))
-> Param
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Param)
forall a b. (a -> b) -> a -> b
$ Key Exps -> Text -> Maybe ByteString -> Maybe ByteString -> Param
Param Key Exps
eExp Text
n Maybe ByteString
forall a. Maybe a
Nothing Maybe ByteString
forall a. Maybe a
Nothing
    infoParams :: [ExperimentInfoParameter]
infoParams = Getting
  [ExperimentInfoParameter]
  ExperimentSetting
  [ExperimentInfoParameter]
-> ExperimentSetting -> [ExperimentInfoParameter]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [ExperimentInfoParameter]
  ExperimentSetting
  [ExperimentInfoParameter]
Lens' ExperimentSetting [ExperimentInfoParameter]
experimentInfoParameters ExperimentSetting
setup
    matchesExpsInfoParam :: ExpsInfoParam -> Bool
matchesExpsInfoParam (ExpsInfoParam Key Exps
_ Text
n ByteString
bs) =
      case (ExperimentInfoParameter -> Bool)
-> [ExperimentInfoParameter] -> Maybe ExperimentInfoParameter
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) (Text -> Bool)
-> (ExperimentInfoParameter -> Text)
-> ExperimentInfoParameter
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExperimentInfoParameter -> Text
infoParameterName) [ExperimentInfoParameter]
infoParams of
        Maybe ExperimentInfoParameter
Nothing -> Bool
False
        Just (ExperimentInfoParameter Text
_ b
p) -> Bool -> Either [Char] Bool -> Bool
forall p a. p -> Either a p -> p
fromEither Bool
False ((b
p b -> b -> Bool
forall a. Eq a => a -> a -> Bool
==) (b -> Bool) -> Either [Char] b -> Either [Char] Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get b -> ByteString -> Either [Char] b
forall a. Get a -> ByteString -> Either [Char] a
S.runGet Get b
forall t. Serialize t => Get t
S.get ByteString
bs)