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


loadExperiments :: (ExperimentDef a) => ExperimentSetting -> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments :: forall a.
ExperimentDef a =>
ExperimentSetting
-> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments ExperimentSetting
setup InputState a
initInpSt a
initSt = do
  Entity Exps
eExp <- 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 = forall record. Entity record -> record
entityVal Entity Exps
eExp
  [Experiment a]
exps <- forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a. Lens' (Experiment a) Int
experimentNumber) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ExperimentDef a => Key Exps -> DB (ExpM a) [Experiment a]
loadExperimentList (forall record. Entity record -> Key record
entityKey Entity Exps
eExp)
  Entity ExpsSetup
eSetup <- forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Setup not found. Your DB is corrupted!") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 (forall record. Entity record -> Key record
entityKey Entity Exps
eExp))
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. NFData a => (a -> b) -> a -> b
$!!
    forall a.
Key Exps
-> Text
-> UTCTime
-> Maybe UTCTime
-> ExpsSetup
-> [ParameterSetup a]
-> [ExperimentInfoParameter]
-> a
-> InputState a
-> [Experiment a]
-> Experiments a
Experiments
      (forall record. Entity record -> Key record
entityKey Entity Exps
eExp)
      (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> Exps -> f Exps
expsName Exps
e)
      (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> Exps -> f Exps
expsStartTime Exps
e)
      (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime)) -> Exps -> f Exps
expsEndTime Exps
e)
      (forall record. Entity record -> record
entityVal Entity ExpsSetup
eSetup)
      (forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
initSt)
      (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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 :: forall a. ExperimentDef a => Key Exps -> DB (ExpM a) [Experiment a]
loadExperimentList Key Exps
expsKey = forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Key Exps) => EntityField Exp typ
ExpExps forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exps
expsKey] [] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 <- forall (m :: * -> *) a1.
MonadIO m =>
Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup Key Exp
k
            forall a.
Key Exp
-> Int
-> UTCTime
-> Maybe UTCTime
-> [ParameterSetting a]
-> [ExperimentResult a]
-> Experiment a
Experiment Key Exp
k (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *). Functor f => (Int -> f Int) -> Exp -> f Exp
expNumber Exp
exp) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> Exp -> f Exp
expStartTime Exp
exp) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime)) -> Exp -> f Exp
expEndTime Exp
exp) [ParameterSetting a]
paramSetting forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise Text
n Maybe ByteString
mBs = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence (forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
n 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 :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
n ByteString
bs =
  let !res :: Either [Char] a
res = forall a. Get a -> ByteString -> Either [Char] a
runGet forall t. Serialize t => Get t
S.get ByteString
bs
   in case Either [Char] a
res of
        Left [Char]
err -> do
          $(logError) forall a b. (a -> b) -> a -> b
$ Text
"Could not deserialise " forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
"! Discarding saved experiment result. Data length: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow (ByteString -> Int
B.length ByteString
bs) forall a. Semigroup a => a -> a -> a
<> Text
". Error Message: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow [Char]
err
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Right a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. a -> Maybe a
Just a
r


loadExperimentResults :: (ExperimentDef a) => Key Exp -> DB (ExpM a) [ExperimentResult a]
loadExperimentResults :: forall a.
ExperimentDef a =>
Key Exp -> DB (ExpM a) [ExperimentResult a]
loadExperimentResults Key Exp
kExp = do
  [Entity ExpResult]
xs <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Key Exp) => EntityField ExpResult typ
ExpResultExp forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exp
kExp] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField ExpResult typ
ExpResultRepetition]
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM 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 :: forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId EndStateType
endSt = do
  ![ByteString]
parts <-
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$!
    case EndStateType
endSt of
      EndStatePrep Key PrepResultData
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> PrepEndStatePart -> f PrepEndStatePart
prepEndStatePartData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepEndStatePart typ
PrepEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField PrepEndStatePart typ
PrepEndStatePartNumber]
      EndStateWarmUp Key WarmUpResultData
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpEndStatePart -> f WarmUpEndStatePart
warmUpEndStatePartData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField WarmUpEndStatePart typ
WarmUpEndStatePartNumber]
      EndStateRep Key RepResultData
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> RepEndStatePart -> f RepEndStatePart
repEndStatePartData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key RepResultData) =>
EntityField RepEndStatePart typ
RepEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField RepEndStatePart typ
RepEndStatePartNumber]
  !Maybe a
res <-
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
parts
      then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      else do
        !Maybe (Serializable a)
mSer <- 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)
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$! forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$! forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$! forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ExperimentDef a => Serializable a -> ExpM a a
deserialisable) Maybe (Serializable a)
mSer
  forall a. NFData a => a -> a
force forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 :: forall a.
ExperimentDef a =>
Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId StartStateType
startSt = do
  ![ByteString]
parts <-
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. NFData a => a -> a
force forall a b. (a -> b) -> a -> b
$!
    case StartStateType
startSt of
      StartStatePrep Key PrepResultData
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> PrepStartStatePart -> f PrepStartStatePart
prepStartStatePartData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepStartStatePart typ
PrepStartStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField PrepStartStatePart typ
PrepStartStatePartNumber]
      StartStateWarmUp Key WarmUpResultData
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpStartStatePart -> f WarmUpStartStatePart
warmUpStartStatePartData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpStartStatePart typ
WarmUpStartStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField WarmUpStartStatePart typ
WarmUpStartStatePartNumber]
      StartStateRep Key RepResultData
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> RepStartStatePart -> f RepStartStatePart
repStartStatePartData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ.
(typ ~ Key RepResultData) =>
EntityField RepStartStatePart typ
RepStartStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField RepStartStatePart typ
RepStartStatePartNumber]
  !a
res <-
    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ByteString]
parts
      then forall a. HasCallStack => [Char] -> a
error [Char]
"Could not get start state"
      else do
        !Serializable a
ser <- forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"Could not deserialise start state ") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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)
        forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$! forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$! forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$! forall a. ExperimentDef a => Serializable a -> ExpM a a
deserialisable Serializable a
ser
  forall a. NFData a => a -> a
force forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> 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 :: forall (m :: * -> *).
MonadIO m =>
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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key PrepResultData -> Int -> ByteString -> PrepEndStatePart
PrepEndStatePart Key PrepResultData
k Int
nr ByteString
part) [forall typ. (typ ~ ByteString) => EntityField PrepEndStatePart typ
PrepEndStatePartData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepEndStatePart typ
PrepEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k, forall typ. (typ ~ Int) => EntityField PrepEndStatePart typ
PrepEndStatePartNumber forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. 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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key WarmUpResultData -> Int -> ByteString -> WarmUpEndStatePart
WarmUpEndStatePart Key WarmUpResultData
k Int
nr ByteString
part) [forall typ.
(typ ~ ByteString) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k, forall typ. (typ ~ Int) => EntityField WarmUpEndStatePart typ
WarmUpEndStatePartNumber forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. 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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key RepResultData -> Int -> ByteString -> RepEndStatePart
RepEndStatePart Key RepResultData
k Int
nr ByteString
part) [forall typ. (typ ~ ByteString) => EntityField RepEndStatePart typ
RepEndStatePartData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key RepResultData) =>
EntityField RepEndStatePart typ
RepEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k, forall typ. (typ ~ Int) => EntityField RepEndStatePart typ
RepEndStatePartNumber forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
parts]
setResDataEndState (EndStatePrep Key PrepResultData
k) Maybe ByteString
Nothing = forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepEndStatePart typ
PrepEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k]
setResDataEndState (EndStateWarmUp Key WarmUpResultData
k) Maybe ByteString
Nothing = forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpEndStatePart typ
WarmUpEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k]
setResDataEndState (EndStateRep Key RepResultData
k) Maybe ByteString
Nothing = forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key RepResultData) =>
EntityField RepEndStatePart typ
RepEndStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k]


setResDataStartState :: (MonadIO m) => StartStateType -> ByteString -> ReaderT SqlBackend m ()
setResDataStartState :: forall (m :: * -> *).
MonadIO m =>
StartStateType -> ByteString -> ReaderT SqlBackend m ()
setResDataStartState (StartStatePrep Key PrepResultData
k) ByteString
bs = do
  let parts :: [ByteString]
parts = ByteString -> [ByteString]
splitState ByteString
bs
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key PrepResultData -> Int -> ByteString -> PrepStartStatePart
PrepStartStatePart Key PrepResultData
k Int
nr ByteString
part) [forall typ.
(typ ~ ByteString) =>
EntityField PrepStartStatePart typ
PrepStartStatePartData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepStartStatePart typ
PrepStartStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
k, forall typ. (typ ~ Int) => EntityField PrepStartStatePart typ
PrepStartStatePartNumber forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. 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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key WarmUpResultData -> Int -> ByteString -> WarmUpStartStatePart
WarmUpStartStatePart Key WarmUpResultData
k Int
nr ByteString
part) [forall typ.
(typ ~ ByteString) =>
EntityField WarmUpStartStatePart typ
WarmUpStartStatePartData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpStartStatePart typ
WarmUpStartStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
k, forall typ. (typ ~ Int) => EntityField WarmUpStartStatePart typ
WarmUpStartStatePartNumber forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. 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
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Int
nr, ByteString
part) -> forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, OnlyOneUniqueKey record,
 SafeToInsert record) =>
record -> [Update record] -> ReaderT backend m (Entity record)
upsert (Key RepResultData -> Int -> ByteString -> RepStartStatePart
RepStartStatePart Key RepResultData
k Int
nr ByteString
part) [forall typ. (typ ~ ByteString) => EntityField RepStartStatePart typ
RepStartStatePartData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ByteString
part]) (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [ByteString]
parts)
  forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [forall typ.
(typ ~ Key RepResultData) =>
EntityField RepStartStatePart typ
RepStartStatePartResultData forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
k, forall typ. (typ ~ Int) => EntityField RepStartStatePart typ
RepStartStatePartNumber forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. 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 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 :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, ExperimentDef a) =>
Key Exp -> a -> ReaderT SqlBackend m a
setParams Key Exp
expId a
st = do
  [ParameterSetting Any]
paramSettings <- forall (m :: * -> *) a1.
MonadIO m =>
Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup Key Exp
expId
  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 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 forall a. Eq a => a -> a -> Bool
== Text
n) [ParameterSetup a]
paramSetup of
             Maybe (ParameterSetup a)
Nothing -> do
               $(logError) forall a b. (a -> b) -> a -> b
$ Text
"Could not find parameter with name " forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
" in the current parameter setting. Thus it cannot be modified!"
               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 forall a. Get a -> ByteString -> Either [Char] a
runGet forall t. Serialize t => Get t
S.get ByteString
bs of
                 Left [Char]
err -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Could not read value of parameter " forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
T.unpack Text
n forall a. Semigroup a => a -> a -> a
<> [Char]
". Aborting! Serializtion error was: " forall a. [a] -> [a] -> [a]
++ [Char]
err
                 Right b
val -> do
                   $(logInfo) forall a b. (a -> b) -> a -> b
$ Text
"Loaded parameter '" forall a. Semigroup a => a -> a -> a
<> Text
n forall a. Semigroup a => a -> a -> a
<> Text
"' value: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
tshow b
val
                   forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ b -> a -> a
setter b
val a
state
        paramSetup :: [ParameterSetup a]
paramSetup = forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
st

loadExperimentResult :: forall a . (ExperimentDef a) => Entity ExpResult -> DB (ExpM a) (ExperimentResult a)
loadExperimentResult :: forall a.
ExperimentDef a =>
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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
P.getEntity 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return 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 = forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (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 = forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (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 <- 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 <- 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 <- forall (m :: * -> *).
MonadIO m =>
Key PrepResultData -> ReaderT SqlBackend m Int
loadPreparationInputCount Key PrepResultData
resDataKey
        !Int
resultCount <- forall (m :: * -> *). MonadIO m => Key PrepResultData -> DB m Int
loadPrepartionMeasuresCount Key PrepResultData
resDataKey
        !Gen RealWorld
startRandG <- forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen ByteString
startRandGenBS
        !Maybe (Gen RealWorld)
endRandG <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen) Maybe ByteString
endRandGenBS
        let !inputVals :: AvailabilityList (ExpM a) (Input a)
inputVals = forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
inpCount, 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 = forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
resultCount, forall (m :: * -> *).
MonadIO m =>
Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadPreparationMeasuresWhere Key PrepResultData
resDataKey)
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. NFData a => (a -> b) -> a -> b
$!! 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
startRandG Maybe (Gen RealWorld)
endRandG AvailabilityList (ExpM a) (Input a)
inputVals AvailabilityList (ExpM a) Measure
res Availability (ExpM a) a
startSt Availability (ExpM a) (Maybe a)
endSt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
mStartInpSt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (Maybe (InputState a))
mEndInpSt
  ![ReplicationResult a]
evalRes <- forall a.
ExperimentDef a =>
Key Exp -> Key ExpResult -> DB (ExpM a) [ReplicationResult a]
loadReplicationResults Key Exp
expId Key ExpResult
k
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. NFData a => (a -> b) -> a -> b
$!! 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 forall a b. (a -> b) -> a -> b
$ 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 = forall (v :: * -> *). Vector v Word32 => v Word32 -> Seed
toSeed (forall {b}. Either [Char] b -> b
fromRight forall a b. (a -> b) -> a -> b
$ forall a. Get a -> ByteString -> Either [Char] a
S.runGet forall t. Serialize t => Get t
S.get ByteString
bs :: V.Vector Word32)
  where fromRight :: Either [Char] b -> b
fromRight (Right b
s) = b
s
        fromRight (Left [Char]
err) = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Could not deserialise random generator. Error Message: " forall a. Semigroup a => a -> a -> a
<> [Char]
err

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


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


loadParamSetup :: (MonadIO m) => Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup :: forall (m :: * -> *) a1.
MonadIO m =>
Key Exp -> ReaderT SqlBackend m [ParameterSetting a1]
loadParamSetup Key Exp
kExp =
  forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall a1 a2.
Lens (ParameterSetting a1) (ParameterSetting a2) Text Text
parameterSettingName) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall {a}. ParamSetting -> ParameterSetting a
mkParameterSetting' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
E.select (forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from forall a b. (a -> b) -> a -> b
$ \SqlExpr (Entity ParamSetting)
pm -> SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity ParamSetting)
pm forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Key Exp) => EntityField ParamSetting typ
ParamSettingExp forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. forall typ. PersistField typ => typ -> SqlExpr (Value typ)
E.val Key Exp
kExp) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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) = forall a.
Text
-> ByteString -> Bool -> ExperimentDesign -> ParameterSetting a
ParameterSetting Text
n ByteString
v Bool
b (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 :: forall (m :: * -> *).
MonadIO m =>
Key PrepResultData -> ReaderT SqlBackend m Int
loadPreparationInputCount Key PrepResultData
kExpRes = forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [forall typ. (typ ~ Key PrepResultData) => EntityField PrepInput typ
PrepInputPrepResultData 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 :: forall (m :: * -> *) a.
(MonadIO m, ExperimentDef a) =>
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 =
        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 forall a b. (a -> b) -> a -> b
$
        forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from 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 forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ PrepInputId) => EntityField PrepInput typ
PrepInputId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity PrepInputValue)
prepIV forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ PrepInputId) => EntityField PrepInputValue typ
PrepInputValuePrepInput)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepInput)
prepI forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Key PrepResultData) => EntityField PrepInput typ
PrepInputPrepResultData forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. 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
          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 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapMC forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, ExperimentDef a) =>
(Entity PrepInput, Entity PrepInputValue) -> m (Maybe (Input a))
mkInput forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| 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 :: forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, ExperimentDef a) =>
(Entity PrepInput, Entity PrepInputValue) -> m (Maybe (Input a))
mkInput (Entity PrepInputId
_ (PrepInput Key PrepResultData
_ Int
p), Entity Key PrepInputValue
_ (PrepInputValue PrepInputId
_ ByteString
v)) = do
      Maybe (InputValue a)
v' <- forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"prep input value" ByteString
v
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> InputValue a -> Input a
Input Int
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputValue a)
v'
loadPreparationInputWhere Key PrepResultData
kExpRes AvailabilityListWhere
GetAll = 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadPreparationInputWhere Key PrepResultData
_ AvailabilityListWhere
where' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepInputWhere was expected"


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


loadPrepartionMeasuresCount :: (MonadIO m) => Key PrepResultData -> DB m Int
loadPrepartionMeasuresCount :: forall (m :: * -> *). MonadIO m => Key PrepResultData -> DB m Int
loadPrepartionMeasuresCount Key PrepResultData
kExpRes = forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepMeasure typ
PrepMeasurePrepResultData 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 :: forall (m :: * -> *).
MonadIO m =>
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 =
        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 forall a b. (a -> b) -> a -> b
$
        forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from 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 forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ PrepMeasureId) => EntityField PrepMeasure typ
PrepMeasureId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity PrepResultStep)
prepRS forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ PrepMeasureId) => EntityField PrepResultStep typ
PrepResultStepMeasure)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity PrepMeasure)
prepM forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepMeasure typ
PrepMeasurePrepResultData forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. 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 [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity PrepMeasure)
prepM forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Int) => EntityField PrepMeasure typ
PrepMeasurePeriod)]
          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 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (Entity PrepMeasure, Entity PrepResultStep) -> Measure
mkMeasure forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> ConduitT a [a] m ()
CL.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Measure Int
measurePeriod) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| 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 PrepMeasureId
_ (PrepMeasure Key PrepResultData
_ Int
p), Entity Key PrepResultStep
_ (PrepResultStep PrepMeasureId
_ 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 (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Measure [StepResult]
measureResults) [Measure]
xs)
    combineMeasures [Measure]
_                  = forall a. HasCallStack => [Char] -> a
error [Char]
"not possible"
loadPreparationMeasuresWhere Key PrepResultData
kExpRes AvailabilityListWhere
GetAll = 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadPreparationMeasuresWhere Key PrepResultData
_ AvailabilityListWhere
where' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepMeasuresWhere was expected"


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


loadReplicationResults :: (ExperimentDef a) => Key Exp -> Key ExpResult -> DB (ExpM a) [ReplicationResult a]
loadReplicationResults :: forall a.
ExperimentDef a =>
Key Exp -> Key ExpResult -> DB (ExpM a) [ReplicationResult a]
loadReplicationResults Key Exp
expId Key ExpResult
kExpRes = do
  [Entity RepResult]
xs <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Key ExpResult) => EntityField RepResult typ
RepResultExpResult forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key ExpResult
kExpRes] [forall record typ. EntityField record typ -> SelectOpt record
Asc forall typ. (typ ~ Int) => EntityField RepResult typ
RepResultRepNr]
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (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 :: forall a.
ExperimentDef a =>
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 <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
P.getEntity forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Key WarmUpResultData)
mWmUpResId
  !Maybe (Entity RepResultData)
mRepRes <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall e backend (m :: * -> *).
(PersistStoreRead backend, PersistRecordBackend e backend,
 MonadIO m) =>
Key e -> ReaderT backend m (Maybe (Entity e))
P.getEntity 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    -> forall (m :: * -> *) a. Monad m => a -> m a
return 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   -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
      Just Entity RepResultData
eRep -> Entity RepResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
mkRep Entity RepResultData
eRep
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. NFData a => (a -> b) -> a -> b
$!! 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 = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> WarmUpResultData -> f WarmUpResultData
warmUpResultDataStartTime WarmUpResultData
wmUpRes
      let wmUpEndTime :: Maybe UTCTime
wmUpEndTime = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime))
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataEndTime WarmUpResultData
wmUpRes
      !Gen RealWorld
wmUpStartRandGen <- forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataStartRandGen WarmUpResultData
wmUpRes)
      !Maybe (Gen RealWorld)
wmUpEndRandGen <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataEndRandGen WarmUpResultData
wmUpRes)
      let !wmUpStartSt :: Availability (ExpM a) a
wmUpStartSt = forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (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 = forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (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 <- forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"warm up start input state" (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString)
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataStartInputState WarmUpResultData
wmUpRes)
      !Maybe (Maybe (InputState a))
mWmUpEndInpSt <- forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise Text
"warm up end input state" (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> WarmUpResultData -> f WarmUpResultData
warmUpResultDataEndInputState WarmUpResultData
wmUpRes)
      !Int
wmUpInpValsCount <- forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpInputCount Key WarmUpResultData
wmUpResKey
      !Int
wmUpMeasuresCount <- forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpMeasuresCount Key WarmUpResultData
wmUpResKey
      let !wmUpInpVals :: AvailabilityList (ExpM a) (Input a)
wmUpInpVals = forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
wmUpInpValsCount, 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 = forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
wmUpMeasuresCount, forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData
-> AvailabilityListWhere -> ConduitM () Measure (DB m) ()
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
wmUpResKey)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
        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
wmUpStartRandGen Maybe (Gen RealWorld)
wmUpEndRandGen AvailabilityList (ExpM a) (Input a)
wmUpInpVals AvailabilityList (ExpM a) Measure
wmUpMeasures Availability (ExpM a) a
wmUpStartSt Availability (ExpM a) (Maybe a)
wmUpEndSt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
mWmUpStartInpSt 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 = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(UTCTime -> f UTCTime) -> RepResultData -> f RepResultData
repResultDataStartTime RepResultData
repRes
      let repEndTime :: Maybe UTCTime
repEndTime = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe UTCTime -> f (Maybe UTCTime))
-> RepResultData -> f RepResultData
repResultDataEndTime RepResultData
repRes
      !Gen RealWorld
repStartRandGen <- forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString) -> RepResultData -> f RepResultData
repResultDataStartRandGen RepResultData
repRes)
      !Maybe (Gen RealWorld)
repEndRandGen <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). MonadIO m => ByteString -> m GenIO
toRandGen) (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> RepResultData -> f RepResultData
repResultDataEndRandGen RepResultData
repRes)
      !Maybe (InputState a)
mRepStartInpSt <- forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"rep start input state" (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(ByteString -> f ByteString) -> RepResultData -> f RepResultData
repResultDataStartInputState RepResultData
repRes)
      !Maybe (Maybe (InputState a))
mRepEndInpSt <- forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> Maybe ByteString -> m (Maybe (Maybe a))
mDeserialise Text
"rep end input state" (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> RepResultData -> f RepResultData
repResultDataEndInputState RepResultData
repRes)
      !Int
repInpValsCount <- forall (m :: * -> *).
MonadIO m =>
Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationInputCount Key RepResultData
repResKey
      !Int
repMeasuresCount <- forall (m :: * -> *).
MonadIO m =>
Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationMeasuresCount Key RepResultData
repResKey
      let !repInpVals :: AvailabilityList (ExpM a) (Input a)
repInpVals = forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
repInpValsCount, 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 = forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
repMeasuresCount, forall (m :: * -> *).
MonadIO m =>
Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadReplicationMeasuresWhere Key RepResultData
repResKey)
      let !repStartSt :: Availability (ExpM a) a
repStartSt = forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (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 = forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId (Key RepResultData -> EndStateType
EndStateRep Key RepResultData
repResKey))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$!
        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
repStartRandGen Maybe (Gen RealWorld)
repEndRandGen AvailabilityList (ExpM a) (Input a)
repInpVals AvailabilityList (ExpM a) Measure
repMeasures Availability (ExpM a) a
repStartSt Availability (ExpM a) (Maybe a)
repEndSt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
mRepStartInpSt 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 :: forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpInputCount Key WarmUpResultData
kExpRes = forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpInput typ
WarmUpInputRepResult 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 :: forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
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 =
       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 forall a b. (a -> b) -> a -> b
$
       forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from 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 forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ WarmUpInputId) => EntityField WarmUpInput typ
WarmUpInputId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity WarmUpInputValue)
warmUpIV forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ WarmUpInputId) =>
EntityField WarmUpInputValue typ
WarmUpInputValueWarmUpInput)
         SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpInput)
warmUpI forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpInput typ
WarmUpInputRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. 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
         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 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapMC forall {m :: * -> *} {a}.
(MonadIO m, MonadLogger m, Serialize (InputValue a)) =>
(Entity WarmUpInput, Entity WarmUpInputValue)
-> m (Maybe (Input a))
mkInput forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| 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 WarmUpInputId
_ (WarmUpInput Key WarmUpResultData
_ Int
p), Entity Key WarmUpInputValue
_ (WarmUpInputValue WarmUpInputId
_ ByteString
v)) = do
      Maybe (InputValue a)
v' <- forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"warm up input value" ByteString
v
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> InputValue a -> Input a
Input Int
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputValue a)
v'
loadReplicationWarmUpInputWhere Key WarmUpResultData
kExpRes AvailabilityListWhere
GetAll = 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationWarmUpInputWhere Key WarmUpResultData
_ AvailabilityListWhere
where' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepInputWhere was expected"


loadReplicationWarmUpMeasuresCount :: (MonadIO m) => Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpMeasuresCount :: forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData -> ReaderT SqlBackend m Int
loadReplicationWarmUpMeasuresCount Key WarmUpResultData
kExpRes = forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpMeasure typ
WarmUpMeasureRepResult 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 :: forall (m :: * -> *).
MonadIO m =>
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 =
        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 forall a b. (a -> b) -> a -> b
$
        forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from 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 forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ WarmUpMeasureId) =>
EntityField WarmUpMeasure typ
WarmUpMeasureId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity WarmUpResultStep)
warmUpRS forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ WarmUpMeasureId) =>
EntityField WarmUpResultStep typ
WarmUpResultStepMeasure)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity WarmUpMeasure)
warmUpM forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpMeasure typ
WarmUpMeasureRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. 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 [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity WarmUpMeasure)
warmUpM forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Int) => EntityField WarmUpMeasure typ
WarmUpMeasurePeriod)]
          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 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (Entity WarmUpMeasure, Entity WarmUpResultStep) -> Measure
mkMeasure forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> ConduitT a [a] m ()
CL.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Measure Int
measurePeriod) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| 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 WarmUpMeasureId
_ (WarmUpMeasure Key WarmUpResultData
_ Int
p), Entity Key WarmUpResultStep
_ (WarmUpResultStep WarmUpMeasureId
_ 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 (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Measure [StepResult]
measureResults) [Measure]
xs)
    combineMeasures [Measure]
_                  = forall a. HasCallStack => [Char] -> a
error [Char]
"not possible"
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
kExpRes AvailabilityListWhere
GetAll = 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
_ AvailabilityListWhere
where' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' forall a. [a] -> [a] -> [a]
++ [Char]
" where PrepMeasuresWhere was expected"

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


loadReplicationInputCount :: (MonadIO m) => Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationInputCount :: forall (m :: * -> *).
MonadIO m =>
Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationInputCount Key RepResultData
kExpRes = forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [forall typ. (typ ~ Key RepResultData) => EntityField RepInput typ
RepInputRepResult 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 :: forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
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 =
       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 forall a b. (a -> b) -> a -> b
$
       forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from 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 forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepInputId) => EntityField RepInput typ
RepInputId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity RepInputValue)
repIV forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepInputId) => EntityField RepInputValue typ
RepInputValueRepInput)
         SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepInput)
repI forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Key RepResultData) => EntityField RepInput typ
RepInputRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. 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
         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 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ConduitT a b m ()
C.mapMC forall {m :: * -> *} {a}.
(MonadIO m, MonadLogger m, Serialize (InputValue a)) =>
(Entity RepInput, Entity RepInputValue) -> m (Maybe (Input a))
mkInput forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| 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 RepInputId
_ (RepInput Key RepResultData
_ Int
p), Entity Key RepInputValue
_ (RepInputValue RepInputId
_ ByteString
v)) = do
      Maybe (InputValue a)
v' <- forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ByteString -> m (Maybe a)
deserialise Text
"eval input value" ByteString
v
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Int -> InputValue a -> Input a
Input Int
p forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputValue a)
v'
loadReplicationInputWhere Key RepResultData
kExpRes AvailabilityListWhere
GetAll = 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationInputWhere Key RepResultData
_ AvailabilityListWhere
where' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' forall a. [a] -> [a] -> [a]
++ [Char]
" where RepInputWhere was expected"


loadReplicationMeasuresCount :: (MonadIO m) => Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationMeasuresCount :: forall (m :: * -> *).
MonadIO m =>
Key RepResultData -> ReaderT SqlBackend m Int
loadReplicationMeasuresCount Key RepResultData
kExpRes = forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m Int
count [forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult 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 :: forall (m :: * -> *).
MonadIO m =>
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 =
        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 forall a b. (a -> b) -> a -> b
$
        forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from 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 forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepMeasureId) => EntityField RepMeasure typ
RepMeasureId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity RepResultStep)
repRS forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepMeasureId) => EntityField RepResultStep typ
RepResultStepMeasure)
          SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
repM forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. 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 [forall a. PersistField a => SqlExpr (Value a) -> SqlExpr OrderBy
E.asc (SqlExpr (Entity RepMeasure)
repM forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Int) => EntityField RepMeasure typ
RepMeasurePeriod)]
          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 forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
C.mapC (Entity RepMeasure, Entity RepResultStep) -> Measure
mkMeasure forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| forall (m :: * -> *) a.
Monad m =>
(a -> a -> Bool) -> ConduitT a [a] m ()
CL.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Measure Int
measurePeriod) forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
C..| 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 RepMeasureId
_ (RepMeasure Key RepResultData
_ Int
p), Entity Key RepResultStep
_ (RepResultStep RepMeasureId
_ 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 (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Measure [StepResult]
measureResults) [Measure]
xs)
    combineMeasures [Measure]
_                  = forall a. HasCallStack => [Char] -> a
error [Char]
"not possible"
loadReplicationMeasuresWhere Key RepResultData
kExpRes AvailabilityListWhere
GetAll = 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReplicationMeasuresWhere Key RepResultData
_ AvailabilityListWhere
where' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' forall a. [a] -> [a] -> [a]
++ [Char]
" where RepMeasuresWhere was expected"


loadReparationAggregateWhere :: (MonadIO m) => Key RepResultData -> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReparationAggregateWhere :: forall (m :: * -> *).
MonadIO m =>
Key RepResultData
-> AggregateFunction -> AvailabilityListWhere -> DB m Double
loadReparationAggregateWhere Key RepResultData
kExpRes AggregateFunction
agg (RepMeasureWhere SqlExpr (Entity RepMeasure)
-> SqlExpr (Entity RepResultStep) -> SqlQuery ()
where') =
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. a -> Maybe a -> a
fromMaybe Double
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Value a -> a
E.unValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head) forall a b. (a -> b) -> a -> b
$
  forall a r (m :: * -> *) backend.
(SqlSelect a r, MonadIO m, SqlBackendCanRead backend) =>
SqlQuery a -> ReaderT backend m [r]
E.select forall a b. (a -> b) -> a -> b
$
  forall a b. From a => (a -> SqlQuery b) -> SqlQuery b
E.from 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 forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepMeasureId) => EntityField RepMeasure typ
RepMeasureId forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. SqlExpr (Entity RepResultStep)
repRS forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ RepMeasureId) => EntityField RepResultStep typ
RepResultStepMeasure)
    SqlExpr (Value Bool) -> SqlQuery ()
E.where_ (SqlExpr (Entity RepMeasure)
repM forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Key RepResultData) => EntityField RepMeasure typ
RepMeasureRepResult forall typ.
PersistField typ =>
SqlExpr (Value typ) -> SqlExpr (Value typ) -> SqlExpr (Value Bool)
E.==. 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
    forall (m :: * -> *) a. Monad m => a -> m a
return (AggregateFunction
agg forall a b. (a -> b) -> a -> b
$ SqlExpr (Entity RepResultStep)
repRS forall typ val.
(PersistEntity val, PersistField typ) =>
SqlExpr (Entity val) -> EntityField val typ -> SqlExpr (Value typ)
E.^. forall typ. (typ ~ Double) => EntityField RepResultStep typ
RepResultStepYValue)
loadReparationAggregateWhere Key RepResultData
kExpRes AggregateFunction
agg AvailabilityListWhere
GetAll = 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)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
loadReparationAggregateWhere Key RepResultData
_ AggregateFunction
_ AvailabilityListWhere
where' = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Wrong Where clause: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show AvailabilityListWhere
where' 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 :: forall a.
ExperimentDef a =>
ExperimentSetting -> InputState a -> a -> DB (ExpM a) (Entity Exps)
getOrCreateExps ExperimentSetting
setup InputState a
initInpSt a
initSt = do
  let name :: Text
name = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExperimentSetting Text
experimentBaseName ExperimentSetting
setup
  [Entity Exps]
expsList <- forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Text) => EntityField Exps typ
ExpsName forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Text
name] []
  [[ExpsInfoParam]]
expsInfoParams <- forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall record. Entity record -> record
entityVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Entity Key Exps
e Exps
_) -> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Key Exps) => EntityField ExpsInfoParam typ
ExpsInfoParamExps forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exps
e] []) [Entity Exps]
expsList
  let expsList' :: [Entity Exps]
expsList' = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter ((\[ExpsInfoParam]
xs -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExperimentInfoParameter]
infoParams forall a. Ord a => a -> a -> Bool
>= forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExpsInfoParam]
xs Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ExpsInfoParam -> Bool
matchesExpsInfoParam [ExpsInfoParam]
xs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a b. [a] -> [b] -> [(a, b)]
zip [Entity Exps]
expsList [[ExpsInfoParam]]
expsInfoParams)
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Entity Exps]
expsList') forall a b. (a -> b) -> a -> b
$ $(logInfo) Text
"No experiment with same Experiment Info Parameters found!"
  [Entity Exps]
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a. ExperimentDef a => Serializable a -> ExpM a a
deserialisable forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either [Char] a
runGet forall t. Serialize t => Get t
S.get ByteString
s
         let other :: Either [Char] (a, InputState a)
other = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] a
serSt forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Get a -> ByteString -> Either [Char] a
runGet forall t. Serialize t => Get t
S.get ByteString
iS
         forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a b. Either a b -> Bool
isLeft Either [Char] (a, InputState a)
other) forall a b. (a -> b) -> a -> b
$ $(logInfo) Text
"Could not deserialise experiment with same name"
         forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall {b} {a}. b -> Either a b -> b
fromEither Bool
False (forall a.
ExperimentDef a =>
(a, InputState a) -> (a, InputState a) -> Bool
equalExperiments (a
initSt, InputState a
initInpSt) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either [Char] (a, InputState a)
other))
      [Entity Exps]
expsList'
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Entity Exps]
expsList') Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Entity Exps]
exps) forall a b. (a -> b) -> a -> b
$ $(logInfo) Text
"Found experiments with same name, but the are different or not deserialisable!"
  [[Entity Param]]
params <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Entity Exps
e -> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Key Exps) => EntityField Param typ
ParamExps forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall record. Entity record -> Key record
entityKey Entity Exps
e] [forall record typ. EntityField record typ -> SelectOpt record
Asc 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 = forall a. Ord a => [a] -> [a]
L.sort forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Param -> Text
mkParamTpl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Key Exps -> ParameterSetup a -> Param
convertParameterSetup (forall record. Entity record -> Key record
entityKey (forall a. [a] -> a
head [Entity Exps]
exps))) (forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
initSt)
  case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((forall a. Eq a => a -> a -> Bool
== [Text]
myParams) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
L.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Param -> Text
mkParamTpl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall record. Entity record -> record
entityVal) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) (forall a b. [a] -> [b] -> [(a, b)]
zip [Entity Exps]
exps [[Entity Param]]
params) of
    Maybe (Entity Exps, [Entity Param])
Nothing -> do
      $(logInfo) Text
"Starting new experiment..."
      UTCTime
time <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      !Serializable a
serInitSt <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable a
initSt
      Entity Exps
eExp <- forall e backend (m :: * -> *).
(PersistStoreWrite backend, PersistRecordBackend e backend,
 SafeToInsert e, MonadIO m, HasCallStack) =>
e -> ReaderT backend m (Entity e)
insertEntity forall a b. (a -> b) -> a -> b
$ Text
-> UTCTime -> Maybe UTCTime -> ByteString -> ByteString -> Exps
Exps Text
name UTCTime
time forall a. Maybe a
Nothing (Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall t. Serialize t => Putter t
put Serializable a
serInitSt) (Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall t. Serialize t => Putter t
put InputState a
initInpSt)
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ Entity Exps -> ExpsSetup
mkExpSetup Entity Exps
eExp
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {backend} {m :: * -> *}.
(BaseBackend backend ~ SqlBackend, MonadIO m,
 PersistStoreWrite backend) =>
Key Exps
-> ExperimentInfoParameter -> ReaderT backend m (Key ExpsInfoParam)
insertInfoParam (forall record. Entity record -> Key record
entityKey Entity Exps
eExp)) [ExperimentInfoParameter]
infoParams
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Key Exps -> ParameterSetup a -> DB (ExpM a) (Key Param)
insertParam (forall record. Entity record -> Key record
entityKey Entity Exps
eExp)) (forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters a
initSt)
      forall (m :: * -> *) a. Monad m => a -> m a
return Entity Exps
eExp
    Just (Entity Exps
eExp, [Entity Param]
_) -> do
      $(logInfo) Text
"Found experiment with same name and parameter settings. Continuing experiment ..."
      [ExpsInfoParam]
expInfoParams <- forall a b. (a -> b) -> [a] -> [b]
map forall record. Entity record -> record
entityVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [forall typ. (typ ~ Key Exps) => EntityField ExpsInfoParam typ
ExpsInfoParamExps forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. forall record. Entity record -> Key record
entityKey Entity Exps
eExp] []
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {backend} {m :: * -> *}.
(BaseBackend backend ~ SqlBackend, MonadIO m,
 PersistStoreWrite backend) =>
Key Exps
-> ExperimentInfoParameter -> ReaderT backend m (Key ExpsInfoParam)
insertInfoParam (forall record. Entity record -> Key record
entityKey Entity Exps
eExp)) (forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view forall (f :: * -> *).
Functor f =>
(Text -> f Text) -> ExpsInfoParam -> f ExpsInfoParam
expsInfoParamName) [ExpsInfoParam]
expInfoParams) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExperimentInfoParameter -> Text
infoParameterName) [ExperimentInfoParameter]
infoParams)
      forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
[record] -> ReaderT backend m ()
putMany [Entity Exps -> ExpsSetup
mkExpSetup Entity Exps
eExp]
      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
        (forall record. Entity record -> Key record
entityKey Entity Exps
eExp)
        (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExperimentSetting Int
experimentRepetitions ExperimentSetting
setup)
        (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExperimentSetting Int
preparationSteps ExperimentSetting
setup)
        (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExperimentSetting Int
evaluationWarmUpSteps ExperimentSetting
setup)
        (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExperimentSetting Int
evaluationSteps ExperimentSetting
setup)
        (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExperimentSetting Int
evaluationReplications ExperimentSetting
setup)
        (forall a. Ord a => a -> a -> a
max Int
1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view 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) = forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ Key Exps -> Text -> ByteString -> ExpsInfoParam
ExpsInfoParam Key Exps
k Text
n (Put -> ByteString
S.runPut forall a b. (a -> b) -> a -> 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 -> DB (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)
_) = forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ Key Exps -> Text -> Maybe ByteString -> Maybe ByteString -> Param
Param Key Exps
eExp Text
n (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut forall a b. (a -> b) -> a -> b
$ forall t. Serialize t => Putter t
put b
minVal) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Put -> ByteString
runPut forall a b. (a -> b) -> a -> 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)
_) = forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend, SafeToInsert record) =>
record -> ReaderT backend m (Key record)
insert forall a b. (a -> b) -> a -> b
$ Key Exps -> Text -> Maybe ByteString -> Maybe ByteString -> Param
Param Key Exps
eExp Text
n forall a. Maybe a
Nothing forall a. Maybe a
Nothing
    infoParams :: [ExperimentInfoParameter]
infoParams = forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' ExperimentSetting [ExperimentInfoParameter]
experimentInfoParameters ExperimentSetting
setup
    matchesExpsInfoParam :: ExpsInfoParam -> Bool
matchesExpsInfoParam (ExpsInfoParam Key Exps
_ Text
n ByteString
bs) =
      case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((forall a. Eq a => a -> a -> Bool
== Text
n) 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) -> forall {b} {a}. b -> Either a b -> b
fromEither Bool
False ((b
p forall a. Eq a => a -> a -> Bool
==) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Get a -> ByteString -> Either [Char] a
S.runGet forall t. Serialize t => Get t
S.get ByteString
bs)