{-# LANGUAGE BangPatterns         #-}
{-# LANGUAGE DeriveGeneric        #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE ScopedTypeVariables  #-}
{-# LANGUAGE Strict               #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE TupleSections        #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns         #-}

module Experimenter.Run
    ( DatabaseSetting (..)
    , MkExperimentSetting
    , execExperiments
    , runExperiments
    , runExperimentsM
    , runExperimentsIO
    , loadExperimentsResultsM
    , loadStateAfterPreparation
    , loadStateAfterPreparation2
    ) where

import           Control.Arrow                (first, (&&&), (***))
import           Control.Arrow                (second)
import           Control.Concurrent.MVar
import           Control.DeepSeq
import           Control.Lens
import           Control.Monad.IO.Class
import           Control.Monad.Logger         (filterLogger, logDebug, logError, logInfo,
                                               runStdoutLoggingT)
import           Control.Monad.Reader
import qualified Data.ByteString              as B
import           Data.Function                (on)
import           Data.Int                     (Int64)
import           Data.IORef
import           Data.List                    (foldl')
import qualified Data.List                    as L
import           Data.Maybe                   (fromJust, fromMaybe, isNothing)
import           Data.Serialize               hiding (get)
import qualified Data.Serialize               as S
import qualified Data.Text                    as T
import           Data.Time                    (addUTCTime, diffUTCTime, getCurrentTime)
import qualified Data.Vector                  as V
import           Database.Persist.Postgresql
import           GHC.Generics
import           Network.HostName             (getHostName)
import           Prelude                      hiding (exp)
import           System.IO
import           System.IO.Unsafe             (unsafePerformIO)
import           System.Posix.Process
import           System.Random.MWC


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


type Updated = Bool
type InitialState a = a
type InitialInputState a = InputState a
type SkipPreparation = Bool
type Rands = ([Seed],[Seed],[Seed]) -- ^ Preparation, Warm Up and Evaluation random generators

data Mode = Master | Slave
  deriving (Mode -> Mode -> Bool
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show)

execExperiments :: (ExperimentDef a) => (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)) -> DatabaseSetting -> MkExperimentSetting a -> InputState a -> a -> IO (Experiments a)
execExperiments :: (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> a
-> IO (Experiments a)
execExperiments ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
runExpM DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt a
initSt = Experiments a -> Experiments a
forall a. NFData a => a -> a
force (Experiments a -> Experiments a)
-> ((Bool, Experiments a) -> Experiments a)
-> (Bool, Experiments a)
-> Experiments a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool, Experiments a) -> Experiments a
forall a b. (a, b) -> b
snd ((Bool, Experiments a) -> Experiments a)
-> IO (Bool, Experiments a) -> IO (Experiments a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> a
-> IO (Bool, Experiments a)
forall a.
ExperimentDef a =>
(ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> a
-> IO (Bool, Experiments a)
runExperiments ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
runExpM DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt a
initSt

-- | Run an experiment with non-monadic initial state. In case the initial state requires monadic effect (e.g. building
-- a Tensorflow model), use `runExperimentsM`!
runExperiments :: (ExperimentDef a) => (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)) -> DatabaseSetting -> MkExperimentSetting a -> InputState a -> a -> IO (Bool, Experiments a)
runExperiments :: (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> a
-> IO (Bool, Experiments a)
runExperiments ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
runExpM DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt a
initSt = (Experiments a -> Experiments a)
-> (Bool, Experiments a) -> (Bool, Experiments a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Experiments a -> Experiments a
forall a. NFData a => a -> a
force ((Bool, Experiments a) -> (Bool, Experiments a))
-> IO (Bool, Experiments a) -> IO (Bool, Experiments a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
forall a.
ExperimentDef a =>
(ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
runner ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
runExpM DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt (a -> ExpM a a
forall (m :: * -> *) a. Monad m => a -> m a
return a
initSt)

runExperimentsM :: (ExperimentDef a) => (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)) -> DatabaseSetting -> MkExperimentSetting a -> InputState a -> ExpM a a -> IO (Bool, Experiments a)
runExperimentsM :: (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
runExperimentsM = (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
forall a.
ExperimentDef a =>
(ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
runner

runExperimentsIO :: (ExperimentDef a, IO ~ ExpM a) => DatabaseSetting -> MkExperimentSetting a -> InputState a -> a -> IO (Bool, Experiments a)
runExperimentsIO :: DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> a
-> IO (Bool, Experiments a)
runExperimentsIO DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt a
initSt = (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
forall a.
ExperimentDef a =>
(ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
runner ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
forall a. a -> a
id DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt (a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
initSt)

runner :: (ExperimentDef a) => (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)) -> DatabaseSetting -> MkExperimentSetting a -> InputState a -> ExpM a a -> IO (Bool, Experiments a)
runner :: (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> IO (Bool, Experiments a)
runner ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
runExpM DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt ExpM a a
mkInitSt =
  ((Bool, Experiments a) -> (Bool, Experiments a))
-> IO (Bool, Experiments a) -> IO (Bool, Experiments a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Experiments a -> Experiments a)
-> (Bool, Experiments a) -> (Bool, Experiments a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Experiments a -> Experiments a
forall a. NFData a => a -> a
force) (IO (Bool, Experiments a) -> IO (Bool, Experiments a))
-> IO (Bool, Experiments a) -> IO (Bool, Experiments a)
forall a b. (a -> b) -> a -> b
$ do
    LoggingT IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ConnectionString
-> Int -> (Pool SqlBackend -> LoggingT IO ()) -> LoggingT IO ()
forall (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m) =>
ConnectionString -> Int -> (Pool SqlBackend -> m a) -> m a
withPostgresqlPool (DatabaseSetting -> ConnectionString
connectionString DatabaseSetting
dbSetup) (DatabaseSetting -> Int
parallelConnections DatabaseSetting
dbSetup) ((Pool SqlBackend -> LoggingT IO ()) -> LoggingT IO ())
-> (Pool SqlBackend -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> Pool SqlBackend -> LoggingT IO ()
forall backend (m :: * -> *) a.
(MonadIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend (NoLoggingT (ResourceT IO)) a
-> Pool backend -> m a
liftSqlPersistMPool (ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
 -> Pool SqlBackend -> LoggingT IO ())
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> Pool SqlBackend
-> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Migration -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateAll ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall (m :: * -> *).
MonadIO m =>
ReaderT SqlBackend (NoLoggingT (ResourceT m)) ()
indexCreation
    ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
runExpM (ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a))
-> ExpM a (Bool, Experiments a) -> IO (Bool, Experiments a)
forall a b. (a -> b) -> a -> b
$
      DatabaseSetting
-> DB (ExpM a) (Bool, Experiments a)
-> ExpM a (Bool, Experiments a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
DatabaseSetting -> DB m a -> m a
runDB DatabaseSetting
dbSetup (DB (ExpM a) (Bool, Experiments a) -> ExpM a (Bool, Experiments a))
-> DB (ExpM a) (Bool, Experiments a)
-> ExpM a (Bool, Experiments a)
forall a b. (a -> b) -> a -> b
$ do
        a
initSt <- LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a)
-> ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall a b. (a -> b) -> a -> b
$ ExpM a a -> ResourceT (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ExpM a a
mkInitSt
        $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Created initial state and will now check the DB for loading or creating experiments"
        let expSetting :: ExperimentSetting
expSetting = MkExperimentSetting a
setup a
initSt
        ExperimentSetting
-> InputState a
-> a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
forall a.
ExperimentDef a =>
ExperimentSetting
-> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments ExperimentSetting
expSetting InputState a
initInpSt a
initSt ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
-> (Experiments a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Experiments a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
forall (m :: * -> *) a.
Monad m =>
Experiments a -> m (Experiments a)
checkUniqueParamNames ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
-> (Experiments a -> DB (ExpM a) (Bool, Experiments a))
-> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DatabaseSetting
-> ExperimentSetting
-> InputState a
-> a
-> Experiments a
-> DB (ExpM a) (Bool, Experiments a)
forall a.
ExperimentDef a =>
DatabaseSetting
-> ExperimentSetting
-> InputState a
-> a
-> Experiments a
-> DB (ExpM a) (Bool, Experiments a)
runExperimenter DatabaseSetting
dbSetup ExperimentSetting
expSetting InputState a
initInpSt a
initSt


loadStateAfterPreparation2 ::
     ExperimentDef a => (ExpM a b -> IO b) -> DatabaseSetting -> (a -> ExperimentSetting) -> InputState a -> ExpM a a -> Int -> Int -> (a -> ExpM a b) -> IO b
loadStateAfterPreparation2 :: (ExpM a b -> IO b)
-> DatabaseSetting
-> (a -> ExperimentSetting)
-> InputState a
-> ExpM a a
-> Int
-> Int
-> (a -> ExpM a b)
-> IO b
loadStateAfterPreparation2 ExpM a b -> IO b
runExpM DatabaseSetting
dbSetup a -> ExperimentSetting
setup InputState a
initInpSt ExpM a a
mkInitSt Int
expNr Int
repNr a -> ExpM a b
runOnExperiments = do
  LoggingT IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT (LoggingT IO () -> IO ()) -> LoggingT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ConnectionString
-> Int -> (Pool SqlBackend -> LoggingT IO ()) -> LoggingT IO ()
forall (m :: * -> *) a.
(MonadLogger m, MonadUnliftIO m) =>
ConnectionString -> Int -> (Pool SqlBackend -> m a) -> m a
withPostgresqlPool (DatabaseSetting -> ConnectionString
connectionString DatabaseSetting
dbSetup) (DatabaseSetting -> Int
parallelConnections DatabaseSetting
dbSetup) ((Pool SqlBackend -> LoggingT IO ()) -> LoggingT IO ())
-> (Pool SqlBackend -> LoggingT IO ()) -> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> Pool SqlBackend -> LoggingT IO ()
forall backend (m :: * -> *) a.
(MonadIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend (NoLoggingT (ResourceT IO)) a
-> Pool backend -> m a
liftSqlPersistMPool (ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
 -> Pool SqlBackend -> LoggingT IO ())
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> Pool SqlBackend
-> LoggingT IO ()
forall a b. (a -> b) -> a -> b
$ Migration -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall (m :: * -> *).
MonadIO m =>
Migration -> ReaderT SqlBackend m ()
runMigration Migration
migrateAll
  ExpM a b -> IO b
runExpM (ExpM a b -> IO b) -> ExpM a b -> IO b
forall a b. (a -> b) -> a -> b
$ DatabaseSetting -> DB (ExpM a) b -> ExpM a b
forall (m :: * -> *) a.
MonadUnliftIO m =>
DatabaseSetting -> DB m a -> m a
runDB DatabaseSetting
dbSetup (DB (ExpM a) b -> ExpM a b) -> DB (ExpM a) b -> ExpM a b
forall a b. (a -> b) -> a -> b
$ do
    a
initSt <- LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a)
-> ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall a b. (a -> b) -> a -> b
$ ExpM a a -> ResourceT (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ExpM a a
mkInitSt
    $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Created initial state and will now check the DB for loading or creating experiments"
    let expSetting :: ExperimentSetting
expSetting = a -> ExperimentSetting
setup a
initSt
    Experiments a
exps <- ExperimentSetting
-> InputState a
-> a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
forall a.
ExperimentDef a =>
ExperimentSetting
-> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments ExperimentSetting
expSetting InputState a
initInpSt a
initSt
    let xs :: [Availability (ExpM a) (Maybe a)]
xs = Experiments a
exps Experiments a
-> Getting
     (Endo [Availability (ExpM a) (Maybe a)])
     (Experiments a)
     (Availability (ExpM a) (Maybe a))
-> [Availability (ExpM a) (Maybe a)]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([Experiment a]
 -> Const (Endo [Availability (ExpM a) (Maybe a)]) [Experiment a])
-> Experiments a
-> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiments a)
forall a. Lens' (Experiments a) [Experiment a]
experiments (([Experiment a]
  -> Const (Endo [Availability (ExpM a) (Maybe a)]) [Experiment a])
 -> Experiments a
 -> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiments a))
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> [Experiment a]
    -> Const (Endo [Availability (ExpM a) (Maybe a)]) [Experiment a])
-> Getting
     (Endo [Availability (ExpM a) (Maybe a)])
     (Experiments a)
     (Availability (ExpM a) (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Experiment a
 -> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a))
-> [Experiment a]
-> Const (Endo [Availability (ExpM a) (Maybe a)]) [Experiment a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((Experiment a
  -> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a))
 -> [Experiment a]
 -> Const (Endo [Availability (ExpM a) (Maybe a)]) [Experiment a])
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> Experiment a
    -> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a))
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)])
         (Availability (ExpM a) (Maybe a)))
-> [Experiment a]
-> Const (Endo [Availability (ExpM a) (Maybe a)]) [Experiment a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Experiment a -> Bool)
-> Optic'
     (->)
     (Const (Endo [Availability (ExpM a) (Maybe a)]))
     (Experiment a)
     (Experiment a)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered Experiment a -> Bool
isExp Optic'
  (->)
  (Const (Endo [Availability (ExpM a) (Maybe a)]))
  (Experiment a)
  (Experiment a)
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> Experiment a
    -> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a))
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)])
         (Availability (ExpM a) (Maybe a)))
-> Experiment a
-> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ExperimentResult a]
 -> Const
      (Endo [Availability (ExpM a) (Maybe a)]) [ExperimentResult a])
-> Experiment a
-> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a)
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults (([ExperimentResult a]
  -> Const
       (Endo [Availability (ExpM a) (Maybe a)]) [ExperimentResult a])
 -> Experiment a
 -> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a))
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> [ExperimentResult a]
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)]) [ExperimentResult a])
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)])
         (Availability (ExpM a) (Maybe a)))
-> Experiment a
-> Const (Endo [Availability (ExpM a) (Maybe a)]) (Experiment a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExperimentResult a
 -> Const
      (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a))
-> [ExperimentResult a]
-> Const
     (Endo [Availability (ExpM a) (Maybe a)]) [ExperimentResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ExperimentResult a
  -> Const
       (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a))
 -> [ExperimentResult a]
 -> Const
      (Endo [Availability (ExpM a) (Maybe a)]) [ExperimentResult a])
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> ExperimentResult a
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a))
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)])
         (Availability (ExpM a) (Maybe a)))
-> [ExperimentResult a]
-> Const
     (Endo [Availability (ExpM a) (Maybe a)]) [ExperimentResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExperimentResult a -> Bool)
-> Optic'
     (->)
     (Const (Endo [Availability (ExpM a) (Maybe a)]))
     (ExperimentResult a)
     (ExperimentResult a)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered ExperimentResult a -> Bool
isExpRep Optic'
  (->)
  (Const (Endo [Availability (ExpM a) (Maybe a)]))
  (ExperimentResult a)
  (ExperimentResult a)
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> ExperimentResult a
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a))
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)])
         (Availability (ExpM a) (Maybe a)))
-> ExperimentResult a
-> Const
     (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ResultData a)
 -> Const
      (Endo [Availability (ExpM a) (Maybe a)]) (Maybe (ResultData a)))
-> ExperimentResult a
-> Const
     (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a)
forall a. Lens' (ExperimentResult a) (Maybe (ResultData a))
preparationResults ((Maybe (ResultData a)
  -> Const
       (Endo [Availability (ExpM a) (Maybe a)]) (Maybe (ResultData a)))
 -> ExperimentResult a
 -> Const
      (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a))
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> Maybe (ResultData a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)]) (Maybe (ResultData a)))
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)])
         (Availability (ExpM a) (Maybe a)))
-> ExperimentResult a
-> Const
     (Endo [Availability (ExpM a) (Maybe a)]) (ExperimentResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResultData a
 -> Const (Endo [Availability (ExpM a) (Maybe a)]) (ResultData a))
-> Maybe (ResultData a)
-> Const
     (Endo [Availability (ExpM a) (Maybe a)]) (Maybe (ResultData a))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ResultData a
  -> Const (Endo [Availability (ExpM a) (Maybe a)]) (ResultData a))
 -> Maybe (ResultData a)
 -> Const
      (Endo [Availability (ExpM a) (Maybe a)]) (Maybe (ResultData a)))
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (Endo [Availability (ExpM a) (Maybe a)])
          (Availability (ExpM a) (Maybe a)))
    -> ResultData a
    -> Const (Endo [Availability (ExpM a) (Maybe a)]) (ResultData a))
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (Endo [Availability (ExpM a) (Maybe a)])
         (Availability (ExpM a) (Maybe a)))
-> Maybe (ResultData a)
-> Const
     (Endo [Availability (ExpM a) (Maybe a)]) (Maybe (ResultData a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Availability (ExpM a) (Maybe a)
 -> Const
      (Endo [Availability (ExpM a) (Maybe a)])
      (Availability (ExpM a) (Maybe a)))
-> ResultData a
-> Const (Endo [Availability (ExpM a) (Maybe a)]) (ResultData a)
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState
        isExp :: Experiment a -> Bool
isExp Experiment a
x = Experiment a
x Experiment a -> Getting Int (Experiment a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Experiment a) Int
forall a. Lens' (Experiment a) Int
experimentNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
expNr
        isExpRep :: ExperimentResult a -> Bool
isExpRep ExperimentResult a
x = ExperimentResult a
x ExperimentResult a -> Getting Int (ExperimentResult a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (ExperimentResult a) Int
forall a. Lens' (ExperimentResult a) Int
repetitionNumber Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
repNr
        fromAvailable :: Availability m p -> p
fromAvailable (Available p
x) = p
x
        fromAvailable Availability m p
_ = String -> p
forall a. HasCallStack => String -> a
error String
"unexpected AvailableOnDemand in loadStateAfterPreparation"
    Maybe a
borl <- Availability (ExpM a) (Maybe a) -> Maybe a
forall (m :: * -> *) p. Availability m p -> p
fromAvailable (Availability (ExpM a) (Maybe a) -> Maybe a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Availability (ExpM a) (Maybe a))
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Availability (ExpM a) (Maybe a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Availability (ExpM a) (Maybe a))
forall (m :: * -> *) b.
Monad m =>
Availability m b -> DB m (Availability m b)
mkAvailable ([Availability (ExpM a) (Maybe a)]
-> Availability (ExpM a) (Maybe a)
forall a. [a] -> a
head [Availability (ExpM a) (Maybe a)]
xs)
    $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Made BORL available"
    LoggingT (ResourceT (ExpM a)) b -> DB (ExpM a) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) b -> DB (ExpM a) b)
-> LoggingT (ResourceT (ExpM a)) b -> DB (ExpM a) b
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) b -> LoggingT (ResourceT (ExpM a)) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) b -> LoggingT (ResourceT (ExpM a)) b)
-> ResourceT (ExpM a) b -> LoggingT (ResourceT (ExpM a)) b
forall a b. (a -> b) -> a -> b
$ ExpM a b -> ResourceT (ExpM a) b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a b -> ResourceT (ExpM a) b)
-> ExpM a b -> ResourceT (ExpM a) b
forall a b. (a -> b) -> a -> b
$ a -> ExpM a b
runOnExperiments (Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust Maybe a
borl)


loadStateAfterPreparation :: (ExperimentDef a) => DatabaseSetting -> Int64 -> Int -> Int -> ExpM a (Maybe a)
loadStateAfterPreparation :: DatabaseSetting -> Int64 -> Int -> Int -> ExpM a (Maybe a)
loadStateAfterPreparation DatabaseSetting
dbSetup Int64
expsId Int
expNr Int
_ =
  LoggingT (ExpM a) (Maybe a) -> ExpM a (Maybe a)
forall (m :: * -> *) a. MonadIO m => LoggingT m a -> m a
runStdoutLoggingT (LoggingT (ExpM a) (Maybe a) -> ExpM a (Maybe a))
-> LoggingT (ExpM a) (Maybe a) -> ExpM a (Maybe a)
forall a b. (a -> b) -> a -> b
$
  (Text -> LogLevel -> Bool)
-> LoggingT (ExpM a) (Maybe a) -> LoggingT (ExpM a) (Maybe a)
forall (m :: * -> *) a.
(Text -> LogLevel -> Bool) -> LoggingT m a -> LoggingT m a
filterLogger (\Text
s LogLevel
_ -> Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
"SQL") (LoggingT (ExpM a) (Maybe a) -> LoggingT (ExpM a) (Maybe a))
-> LoggingT (ExpM a) (Maybe a) -> LoggingT (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$
  ConnectionString
-> (SqlBackend -> LoggingT (ExpM a) (Maybe a))
-> LoggingT (ExpM a) (Maybe a)
forall (m :: * -> *) a.
(MonadUnliftIO m, MonadLogger m) =>
ConnectionString -> (SqlBackend -> m a) -> m a
withPostgresqlConn (DatabaseSetting -> ConnectionString
connectionString DatabaseSetting
dbSetup) ((SqlBackend -> LoggingT (ExpM a) (Maybe a))
 -> LoggingT (ExpM a) (Maybe a))
-> (SqlBackend -> LoggingT (ExpM a) (Maybe a))
-> LoggingT (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ \(SqlBackend
backend :: SqlBackend) ->
    (ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
 -> SqlBackend -> LoggingT (ExpM a) (Maybe a))
-> SqlBackend
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
-> LoggingT (ExpM a) (Maybe a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
-> SqlBackend -> LoggingT (ExpM a) (Maybe a)
forall backend (m :: * -> *) a.
(MonadUnliftIO m, BackendCompatible SqlBackend backend) =>
ReaderT backend m a -> backend -> m a
runSqlConn SqlBackend
backend (ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
 -> LoggingT (ExpM a) (Maybe a))
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
-> LoggingT (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
      (Entity Key Exp
expId Exp
_) <- Entity Exp -> Maybe (Entity Exp) -> Entity Exp
forall a. a -> Maybe a -> a
fromMaybe (String -> Entity Exp
forall a. HasCallStack => String -> a
error String
"experiments not found") (Maybe (Entity Exp) -> Entity Exp)
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe (Entity Exp))
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Entity Exp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter Exp]
-> [SelectOpt Exp]
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe (Entity Exp))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [EntityField Exp (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField Exp typ
ExpExps EntityField Exp (Key Exps) -> Key Exps -> Filter Exp
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Int64 -> Key Exps
forall record.
ToBackendKey SqlBackend record =>
Int64 -> Key record
toSqlKey Int64
expsId, EntityField Exp Int
forall typ. (typ ~ Int) => EntityField Exp typ
ExpNumber EntityField Exp Int -> Int -> Filter Exp
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Int
expNr] []
      (Entity Key ExpResult
_ ExpResult
expRes) <- Entity ExpResult -> Maybe (Entity ExpResult) -> Entity ExpResult
forall a. a -> Maybe a -> a
fromMaybe (String -> Entity ExpResult
forall a. HasCallStack => String -> a
error String
"experiment not found") (Maybe (Entity ExpResult) -> Entity ExpResult)
-> ReaderT
     SqlBackend (LoggingT (ExpM a)) (Maybe (Entity ExpResult))
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Entity ExpResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter ExpResult]
-> [SelectOpt ExpResult]
-> ReaderT
     SqlBackend (LoggingT (ExpM a)) (Maybe (Entity ExpResult))
forall backend (m :: * -> *) record.
(PersistQueryRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m (Maybe (Entity record))
selectFirst [EntityField ExpResult (Key Exp)
forall typ. (typ ~ Key Exp) => EntityField ExpResult typ
ExpResultExp EntityField ExpResult (Key Exp) -> Key Exp -> Filter ExpResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exp
expId] []
      case ExpResult
expRes ExpResult
-> Getting
     (Maybe (Key PrepResultData)) ExpResult (Maybe (Key PrepResultData))
-> Maybe (Key PrepResultData)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Key PrepResultData)) ExpResult (Maybe (Key PrepResultData))
forall (f :: * -> *).
Functor f =>
(Maybe (Key PrepResultData) -> f (Maybe (Key PrepResultData)))
-> ExpResult -> f ExpResult
expResultPrepResultData of
        Maybe (Key PrepResultData)
Nothing -> Maybe a -> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        Just Key PrepResultData
prepResDataId -> do
          [ConnectionString]
parts' <- (Entity PrepEndStatePart -> ConnectionString)
-> [Entity PrepEndStatePart] -> [ConnectionString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Getting ConnectionString PrepEndStatePart ConnectionString
-> PrepEndStatePart -> ConnectionString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConnectionString PrepEndStatePart ConnectionString
forall (f :: * -> *).
Functor f =>
(ConnectionString -> f ConnectionString)
-> PrepEndStatePart -> f PrepEndStatePart
prepEndStatePartData (PrepEndStatePart -> ConnectionString)
-> (Entity PrepEndStatePart -> PrepEndStatePart)
-> Entity PrepEndStatePart
-> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity PrepEndStatePart -> PrepEndStatePart
forall record. Entity record -> record
entityVal) ([Entity PrepEndStatePart] -> [ConnectionString])
-> ReaderT SqlBackend (LoggingT (ExpM a)) [Entity PrepEndStatePart]
-> ReaderT SqlBackend (LoggingT (ExpM a)) [ConnectionString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Filter PrepEndStatePart]
-> [SelectOpt PrepEndStatePart]
-> ReaderT SqlBackend (LoggingT (ExpM a)) [Entity PrepEndStatePart]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField PrepEndStatePart (Key PrepResultData)
forall typ.
(typ ~ Key PrepResultData) =>
EntityField PrepEndStatePart typ
PrepEndStatePartResultData EntityField PrepEndStatePart (Key PrepResultData)
-> Key PrepResultData -> Filter PrepEndStatePart
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
prepResDataId] [EntityField PrepEndStatePart Int -> SelectOpt PrepEndStatePart
forall record typ. EntityField record typ -> SelectOpt record
Asc EntityField PrepEndStatePart Int
forall typ. (typ ~ Int) => EntityField PrepEndStatePart typ
PrepEndStatePartNumber]
          if [ConnectionString] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ConnectionString]
parts'
            then Maybe a -> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
            else do
              !Maybe (Serializable a)
mSer <- LoggingT (ExpM a) (Maybe (Serializable a))
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ExpM a) (Maybe (Serializable a))
 -> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe (Serializable a)))
-> LoggingT (ExpM a) (Maybe (Serializable a))
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe (Serializable a))
forall a b. (a -> b) -> a -> b
$! Text
-> ConnectionString -> LoggingT (ExpM a) (Maybe (Serializable a))
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, Serialize a) =>
Text -> ConnectionString -> m (Maybe a)
deserialise (String -> Text
T.pack String
"end state") ([ConnectionString] -> ConnectionString
B.concat [ConnectionString]
parts')
              !Maybe a
res <- LoggingT (ExpM a) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ExpM a) (Maybe a)
 -> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a))
-> LoggingT (ExpM a) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
forall a b. (a -> b) -> a -> b
$! ExpM a (Maybe a) -> LoggingT (ExpM a) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Maybe a) -> LoggingT (ExpM a) (Maybe a))
-> ExpM a (Maybe a) -> LoggingT (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ ExpM a (Maybe a)
-> (Serializable a -> ExpM a (Maybe a))
-> Maybe (Serializable a)
-> ExpM a (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a -> ExpM a (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) ((a -> Maybe a) -> ExpM a a -> ExpM a (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (ExpM a a -> ExpM a (Maybe a))
-> (Serializable a -> ExpM a a)
-> Serializable a
-> ExpM a (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Serializable a -> ExpM a a
forall a. ExperimentDef a => Serializable a -> ExpM a a
deserialisable) Maybe (Serializable a)
mSer
              Maybe a -> Maybe a
forall a. NFData a => a -> a
force (Maybe a -> Maybe a)
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> (a -> ReaderT SqlBackend (LoggingT (ExpM a)) a)
-> Maybe a -> ReaderT SqlBackend (LoggingT (ExpM a)) (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Key Exp -> a -> ReaderT SqlBackend (LoggingT (ExpM a)) a
forall (m :: * -> *) a.
(MonadIO m, MonadLogger m, ExperimentDef a) =>
Key Exp -> a -> ReaderT SqlBackend m a
setParams Key Exp
expId) Maybe a
res

type OnlyFinishedExperiments = Bool

loadExperimentsResultsM ::
     (ExperimentDef a)
  => OnlyFinishedExperiments
  -> (ExpM a (Maybe (Experiments a)) -> IO (Maybe (Experiments a)))
  -> DatabaseSetting
  -> MkExperimentSetting a
  -> InputState a
  -> ExpM a a
  -> Int64
  -> IO (Maybe (Experiments a))
loadExperimentsResultsM :: Bool
-> (ExpM a (Maybe (Experiments a)) -> IO (Maybe (Experiments a)))
-> DatabaseSetting
-> MkExperimentSetting a
-> InputState a
-> ExpM a a
-> Int64
-> IO (Maybe (Experiments a))
loadExperimentsResultsM Bool
filtFin ExpM a (Maybe (Experiments a)) -> IO (Maybe (Experiments a))
runExpM DatabaseSetting
dbSetup MkExperimentSetting a
setup InputState a
initInpSt ExpM a a
mkInitSt Int64
key =
  ExpM a (Maybe (Experiments a)) -> IO (Maybe (Experiments a))
runExpM (ExpM a (Maybe (Experiments a)) -> IO (Maybe (Experiments a)))
-> ExpM a (Maybe (Experiments a)) -> IO (Maybe (Experiments a))
forall a b. (a -> b) -> a -> b
$ DatabaseSetting
-> DB (ExpM a) (Maybe (Experiments a))
-> ExpM a (Maybe (Experiments a))
forall (m :: * -> *) a.
MonadUnliftIO m =>
DatabaseSetting -> DB m a -> m a
runDB DatabaseSetting
dbSetup (DB (ExpM a) (Maybe (Experiments a))
 -> ExpM a (Maybe (Experiments a)))
-> DB (ExpM a) (Maybe (Experiments a))
-> ExpM a (Maybe (Experiments a))
forall a b. (a -> b) -> a -> b
$ do
    a
initSt <- LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a)
-> ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall a b. (a -> b) -> a -> b
$ ExpM a a -> ResourceT (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ExpM a a
mkInitSt
    let sett :: ExperimentSetting
sett = MkExperimentSetting a
setup a
initSt
        skipPrep :: Experiment a1 -> Bool
skipPrep Experiment a1
exp' = (ParameterSetting a1 -> Bool) -> [ParameterSetting a1] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ParameterSetting a1
-> Getting Bool (ParameterSetting a1) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ParameterSetting a1) Bool
forall a1 a2.
Lens (ParameterSetting a1) (ParameterSetting a2) Bool Bool
parameterSettingSkipPreparationPhase) (Experiment a1
exp' Experiment a1
-> Getting
     [ParameterSetting a1] (Experiment a1) [ParameterSetting a1]
-> [ParameterSetting a1]
forall s a. s -> Getting a s a -> a
^. Getting [ParameterSetting a1] (Experiment a1) [ParameterSetting a1]
forall a. Lens' (Experiment a) [ParameterSetting a]
parameterSetup)
        isFinished :: Experiment a -> Bool
isFinished Experiment a
exp' =
          [ExperimentResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Experiment a
exp' Experiment a
-> Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
-> [ExperimentResult a]
forall s a. s -> Getting a s a -> a
^. Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentSetting
sett ExperimentSetting -> Getting Int ExperimentSetting Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
experimentRepetitions Bool -> Bool -> Bool
&& -- repetitions
          (Experiment a -> Bool
forall a1. Experiment a1 -> Bool
skipPrep Experiment a
exp' Bool -> Bool -> Bool
|| (ExperimentResult a -> Bool) -> [ExperimentResult a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ExperimentResult a
expRes -> Int -> (ResultData a -> Int) -> Maybe (ResultData a) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (AvailabilityList (ExpM a) Measure -> Int)
-> (ResultData a -> AvailabilityList (ExpM a) Measure)
-> ResultData a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
-> ResultData a -> AvailabilityList (ExpM a) Measure
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) (ExperimentResult a
expRes ExperimentResult a
-> Getting
     (Maybe (ResultData a)) (ExperimentResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ExperimentResult a) (Maybe (ResultData a))
forall a. Lens' (ExperimentResult a) (Maybe (ResultData a))
preparationResults) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentSetting
sett ExperimentSetting -> Getting Int ExperimentSetting Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
preparationSteps) (Experiment a
exp' Experiment a
-> Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
-> [ExperimentResult a]
forall s a. s -> Getting a s a -> a
^. Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults)) Bool -> Bool -> Bool
&& -- preparation length
          (ExperimentResult a -> Bool) -> [ExperimentResult a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\ExperimentResult a
expRes -> [ReplicationResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (ExperimentResult a
expRes ExperimentResult a
-> Getting
     [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
-> [ReplicationResult a]
forall s a. s -> Getting a s a -> a
^. Getting
  [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentSetting
sett ExperimentSetting -> Getting Int ExperimentSetting Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
evaluationReplications) (Experiment a
exp' Experiment a
-> Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
-> [ExperimentResult a]
forall s a. s -> Getting a s a -> a
^. Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults) Bool -> Bool -> Bool
&& -- replications
          (ReplicationResult a -> Bool) -> [ReplicationResult a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            (\ReplicationResult a
expRes -> Int -> (ResultData a -> Int) -> Maybe (ResultData a) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (AvailabilityList (ExpM a) Measure -> Int)
-> (ResultData a -> AvailabilityList (ExpM a) Measure)
-> ResultData a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
-> ResultData a -> AvailabilityList (ExpM a) Measure
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) (ReplicationResult a
expRes ReplicationResult a
-> Getting
     (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
warmUpResults) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentSetting
sett ExperimentSetting -> Getting Int ExperimentSetting Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
evaluationWarmUpSteps)
            (Experiment a
exp' Experiment a
-> Getting
     [ReplicationResult a] (Experiment a) [ReplicationResult a]
-> [ReplicationResult a]
forall s a. s -> Getting a s a -> a
^. ([ExperimentResult a]
 -> Const [ReplicationResult a] [ExperimentResult a])
-> Experiment a -> Const [ReplicationResult a] (Experiment a)
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults (([ExperimentResult a]
  -> Const [ReplicationResult a] [ExperimentResult a])
 -> Experiment a -> Const [ReplicationResult a] (Experiment a))
-> (([ReplicationResult a]
     -> Const [ReplicationResult a] [ReplicationResult a])
    -> [ExperimentResult a]
    -> Const [ReplicationResult a] [ExperimentResult a])
-> Getting
     [ReplicationResult a] (Experiment a) [ReplicationResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExperimentResult a
 -> Const [ReplicationResult a] (ExperimentResult a))
-> [ExperimentResult a]
-> Const [ReplicationResult a] [ExperimentResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ExperimentResult a
  -> Const [ReplicationResult a] (ExperimentResult a))
 -> [ExperimentResult a]
 -> Const [ReplicationResult a] [ExperimentResult a])
-> Getting
     [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
-> ([ReplicationResult a]
    -> Const [ReplicationResult a] [ReplicationResult a])
-> [ExperimentResult a]
-> Const [ReplicationResult a] [ExperimentResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults) Bool -> Bool -> Bool
&& -- warm up length
          (ReplicationResult a -> Bool) -> [ReplicationResult a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            (\ReplicationResult a
expRes -> Int -> (ResultData a -> Int) -> Maybe (ResultData a) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (AvailabilityList (ExpM a) Measure -> Int)
-> (ResultData a -> AvailabilityList (ExpM a) Measure)
-> ResultData a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
-> ResultData a -> AvailabilityList (ExpM a) Measure
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) (ReplicationResult a
expRes ReplicationResult a
-> Getting
     (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentSetting
sett ExperimentSetting -> Getting Int ExperimentSetting Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int ExperimentSetting Int
Lens' ExperimentSetting Int
evaluationSteps)
            (Experiment a
exp' Experiment a
-> Getting
     [ReplicationResult a] (Experiment a) [ReplicationResult a]
-> [ReplicationResult a]
forall s a. s -> Getting a s a -> a
^. ([ExperimentResult a]
 -> Const [ReplicationResult a] [ExperimentResult a])
-> Experiment a -> Const [ReplicationResult a] (Experiment a)
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults (([ExperimentResult a]
  -> Const [ReplicationResult a] [ExperimentResult a])
 -> Experiment a -> Const [ReplicationResult a] (Experiment a))
-> (([ReplicationResult a]
     -> Const [ReplicationResult a] [ReplicationResult a])
    -> [ExperimentResult a]
    -> Const [ReplicationResult a] [ExperimentResult a])
-> Getting
     [ReplicationResult a] (Experiment a) [ReplicationResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExperimentResult a
 -> Const [ReplicationResult a] (ExperimentResult a))
-> [ExperimentResult a]
-> Const [ReplicationResult a] [ExperimentResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ExperimentResult a
  -> Const [ReplicationResult a] (ExperimentResult a))
 -> [ExperimentResult a]
 -> Const [ReplicationResult a] [ExperimentResult a])
-> Getting
     [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
-> ([ReplicationResult a]
    -> Const [ReplicationResult a] [ReplicationResult a])
-> [ExperimentResult a]
-> Const [ReplicationResult a] [ExperimentResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults) -- eval length
        filterFinished :: Experiments a -> Experiments a
filterFinished =
          ASetter
  (Experiments a) (Experiments a) [Experiment a] [Experiment a]
-> ([Experiment a] -> [Experiment a])
-> Experiments a
-> Experiments a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over
            ASetter
  (Experiments a) (Experiments a) [Experiment a] [Experiment a]
forall a. Lens' (Experiments a) [Experiment a]
experiments
            (if Bool
filtFin
               then (Experiment a -> Bool) -> [Experiment a] -> [Experiment a]
forall a. (a -> Bool) -> [a] -> [a]
filter Experiment a -> Bool
isFinished
               else [Experiment a] -> [Experiment a]
forall a. a -> a
id)
    (Experiments a -> Experiments a)
-> Maybe (Experiments a) -> Maybe (Experiments a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Experiments a -> Experiments a
filterFinished (Maybe (Experiments a) -> Maybe (Experiments a))
-> DB (ExpM a) (Maybe (Experiments a))
-> DB (ExpM a) (Maybe (Experiments a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExperimentSetting
-> InputState a
-> a
-> Key Exps
-> DB (ExpM a) (Maybe (Experiments a))
forall a.
ExperimentDef a =>
ExperimentSetting
-> InputState a
-> a
-> Key Exps
-> DB (ExpM a) (Maybe (Experiments a))
loadExperimentsResults ExperimentSetting
sett InputState a
initInpSt a
initSt (Int64 -> Key Exps
forall record.
ToBackendKey SqlBackend record =>
Int64 -> Key record
toSqlKey Int64
key)


checkUniqueParamNames :: (Monad m) => Experiments a -> m (Experiments a)
checkUniqueParamNames :: Experiments a -> m (Experiments a)
checkUniqueParamNames Experiments a
exps = do
  let paramNames :: [Text]
paramNames = (ParameterSetup a -> Text) -> [ParameterSetup a] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ParameterSetup a -> Text
forall a. ParameterSetup a -> Text
parameterName (Getting [ParameterSetup a] (Experiments a) [ParameterSetup a]
-> Experiments a -> [ParameterSetup a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ParameterSetup a] (Experiments a) [ParameterSetup a]
forall a. Lens' (Experiments a) [ParameterSetup a]
experimentsParameters Experiments a
exps)
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (([Text] -> Bool) -> [[Text]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1) (Int -> Bool) -> ([Text] -> Int) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([Text] -> [[Text]]
forall a. Eq a => [a] -> [[a]]
L.group ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort [Text]
paramNames)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall a. HasCallStack => String -> a
error (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"Parameter names must be unique! " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Text]] -> String
forall a. Show a => a -> String
show (([Text] -> Bool) -> [[Text]] -> [[Text]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
1) (Int -> Bool) -> ([Text] -> Int) -> [Text] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([Text] -> [[Text]]
forall a. Eq a => [a] -> [[a]]
L.group ([Text] -> [[Text]]) -> [Text] -> [[Text]]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Ord a => [a] -> [a]
L.sort [Text]
paramNames))
  Experiments a -> m (Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return Experiments a
exps


runExperimenter :: (ExperimentDef a) => DatabaseSetting -> ExperimentSetting -> InputState a -> a -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
runExperimenter :: DatabaseSetting
-> ExperimentSetting
-> InputState a
-> a
-> Experiments a
-> DB (ExpM a) (Bool, Experiments a)
runExperimenter DatabaseSetting
dbSetup ExperimentSetting
setup InputState a
initInpSt a
initSt Experiments a
exps = do
  !ProcessID
pid <- IO ProcessID
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ProcessID
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ProcessID
getProcessID
  !String
hostName <- IO String
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getHostName
  !UTCTime
time <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [Filter ExpsMaster]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField ExpsMaster UTCTime
forall typ. (typ ~ UTCTime) => EntityField ExpsMaster typ
ExpsMasterLastAliveSign EntityField ExpsMaster UTCTime -> UTCTime -> Filter ExpsMaster
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
<=. NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
2NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*NominalDiffTime
forall t. Num t => t
keepAliveTimeout) UTCTime
time]
  !Maybe (Key ExpsMaster)
maybeMaster <- ExpsMaster
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Key ExpsMaster))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique (ExpsMaster
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Key ExpsMaster)))
-> ExpsMaster
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Key ExpsMaster))
forall a b. (a -> b) -> a -> b
$ Key Exps -> Text -> Int -> UTCTime -> ExpsMaster
ExpsMaster (Experiments a
exps Experiments a
-> Getting (Key Exps) (Experiments a) (Key Exps) -> Key Exps
forall s a. s -> Getting a s a -> a
^. Getting (Key Exps) (Experiments a) (Key Exps)
forall a. Lens' (Experiments a) (Key Exps)
experimentsKey) (String -> Text
T.pack String
hostName) (ProcessID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ProcessID
pid) UTCTime
time
  ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
  case Maybe (Key ExpsMaster)
maybeMaster of
    Just Key ExpsMaster
masterId -> do
      !IORef WorkerStatus
ref <- IO (IORef WorkerStatus)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (IORef WorkerStatus)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef WorkerStatus)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (IORef WorkerStatus))
-> IO (IORef WorkerStatus)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (IORef WorkerStatus)
forall a b. (a -> b) -> a -> b
$ DatabaseSetting
-> (UTCTime -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ())
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> IO (IORef WorkerStatus)
createKeepAliveFork DatabaseSetting
dbSetup (\UTCTime
t -> Key ExpsMaster
-> [Update ExpsMaster]
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key ExpsMaster
masterId [EntityField ExpsMaster UTCTime
forall typ. (typ ~ UTCTime) => EntityField ExpsMaster typ
ExpsMasterLastAliveSign EntityField ExpsMaster UTCTime -> UTCTime -> Update ExpsMaster
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. UTCTime
t]) (Key ExpsMaster -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key ExpsMaster
masterId)
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Running in MASTER mode!"
      !(Bool, Experiments a)
res <- DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
forall a.
ExperimentDef a =>
DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
runExperiment DatabaseSetting
dbSetup Mode
Master Experiments a
exps
      !Bool
waitResult <- Experiments a -> DB (ExpM a) Bool
forall (m :: * -> *) a. MonadIO m => Experiments a -> DB m Bool
waitForSlaves Experiments a
exps
      if Bool
waitResult
        then do
          IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef WorkerStatus -> WorkerStatus -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef WorkerStatus
ref WorkerStatus
Finished)
          Experiments a
exps' <- ExperimentSetting
-> InputState a
-> a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
forall a.
ExperimentDef a =>
ExperimentSetting
-> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments ExperimentSetting
setup InputState a
initInpSt a
initSt -- done, reload all data!
          (Bool, Experiments a) -> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Experiments a) -> Bool
forall a b. (a, b) -> a
fst (Bool, Experiments a)
res, Experiments a
exps')
        else Key ExpsMaster
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key ExpsMaster
masterId ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> DB (ExpM a) (Bool, Experiments a)
-> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> DB (ExpM a) (Bool, Experiments a)
restartExperimenter -- slave died
    Maybe (Key ExpsMaster)
Nothing -> do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Running in SLAVE mode!"
      DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
forall a.
ExperimentDef a =>
DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
runExperiment DatabaseSetting
dbSetup Mode
Slave Experiments a
exps
  where
    restartExperimenter :: DB (ExpM a) (Bool, Experiments a)
restartExperimenter = ExperimentSetting
-> InputState a
-> a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
forall a.
ExperimentDef a =>
ExperimentSetting
-> InputState a -> a -> DB (ExpM a) (Experiments a)
loadExperiments ExperimentSetting
setup InputState a
initInpSt a
initSt ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
-> (Experiments a -> DB (ExpM a) (Bool, Experiments a))
-> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DatabaseSetting
-> ExperimentSetting
-> InputState a
-> a
-> Experiments a
-> DB (ExpM a) (Bool, Experiments a)
forall a.
ExperimentDef a =>
DatabaseSetting
-> ExperimentSetting
-> InputState a
-> a
-> Experiments a
-> DB (ExpM a) (Bool, Experiments a)
runExperimenter DatabaseSetting
dbSetup ExperimentSetting
setup InputState a
initInpSt a
initSt

runExperiment :: (ExperimentDef a) => DatabaseSetting -> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
runExperiment :: DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
runExperiment DatabaseSetting
dbSetup Mode
mode Experiments a
exps = do
  (Bool
anyChange, Experiments a
exps') <- DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
forall a.
ExperimentDef a =>
DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
continueExperiments DatabaseSetting
dbSetup Mode
mode Experiments a
exps
  if Bool
anyChange
    then (Bool -> Bool) -> (Bool, Experiments a) -> (Bool, Experiments a)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True) ((Bool, Experiments a) -> (Bool, Experiments a))
-> DB (ExpM a) (Bool, Experiments a)
-> DB (ExpM a) (Bool, Experiments a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
forall a.
ExperimentDef a =>
DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
runExperiment DatabaseSetting
dbSetup Mode
mode Experiments a
exps'
    else (Bool, Experiments a) -> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
anyChange, Experiments a
exps')


continueExperiments :: (ExperimentDef a) => DatabaseSetting -> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
continueExperiments :: DatabaseSetting
-> Mode -> Experiments a -> DB (ExpM a) (Bool, Experiments a)
continueExperiments DatabaseSetting
dbSetup Mode
mode Experiments a
exp = do
  $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Processing set of experiments with ID " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (BackendKey SqlBackend -> Int64
unSqlBackendKey (BackendKey SqlBackend -> Int64) -> BackendKey SqlBackend -> Int64
forall a b. (a -> b) -> a -> b
$ Key Exps -> BackendKey SqlBackend
unExpsKey (Key Exps -> BackendKey SqlBackend)
-> Key Exps -> BackendKey SqlBackend
forall a b. (a -> b) -> a -> b
$ Experiments a
exp Experiments a
-> Getting (Key Exps) (Experiments a) (Key Exps) -> Key Exps
forall s a. s -> Getting a s a -> a
^. Getting (Key Exps) (Experiments a) (Key Exps)
forall a. Lens' (Experiments a) (Key Exps)
experimentsKey)
  IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Handle -> IO ()
hFlush Handle
stdout
  let exps :: [Experiment a]
exps = Experiments a
exp Experiments a
-> Getting [Experiment a] (Experiments a) [Experiment a]
-> [Experiment a]
forall s a. s -> Getting a s a -> a
^. Getting [Experiment a] (Experiments a) [Experiment a]
forall a. Lens' (Experiments a) [Experiment a]
experiments
  if Mode
mode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
Slave Bool -> Bool -> Bool
&& [Experiment a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Experiment a]
exps
    then do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"No experiments found and running in slave mode. Check whether the master has initialised the experiment yet!"
      (Bool, Experiments a) -> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Experiments a
exp)
    else do
      ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
printInfoParamSetup
      Rands
rands <- IO Rands
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Rands
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Rands
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Rands)
-> IO Rands
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Rands
forall a b. (a -> b) -> a -> b
$ [Experiment a] -> IO Rands
forall a. [Experiment a] -> IO Rands
mkRands [Experiment a]
exps
      [Experiment a]
newExps <-
        if Mode
mode Mode -> Mode -> Bool
forall a. Eq a => a -> a -> Bool
== Mode
Slave
          then [Experiment a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          else Experiments a
-> [Experiment a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Experiment a]
forall a.
ExperimentDef a =>
Experiments a -> [Experiment a] -> DB (ExpM a) [Experiment a]
mkNewExps Experiments a
exp [Experiment a]
exps
      let expsList :: [Experiment a]
expsList = [Experiment a]
exps [Experiment a] -> [Experiment a] -> [Experiment a]
forall a. [a] -> [a] -> [a]
++ [Experiment a]
newExps
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Number of experiments loaded: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([Experiment a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Experiment a]
exps)
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Number of new experiments: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([Experiment a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Experiment a]
newExps)
      [(Bool, Experiment a)]
expRes <- (Experiment a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, Experiment a))
-> [Experiment a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [(Bool, Experiment a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (DatabaseSetting
-> Rands
-> Experiments a
-> Experiment a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, Experiment a)
forall a.
ExperimentDef a =>
DatabaseSetting
-> Rands
-> Experiments a
-> Experiment a
-> DB (ExpM a) (Bool, Experiment a)
continueExperiment DatabaseSetting
dbSetup Rands
rands Experiments a
exp) [Experiment a]
expsList
      let updated :: Bool
updated = ((Bool, Experiment a) -> Bool) -> [(Bool, Experiment a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, Experiment a) -> Bool
forall a b. (a, b) -> a
fst [(Bool, Experiment a)]
expRes
          res :: [Experiment a]
res = ((Bool, Experiment a) -> Experiment a)
-> [(Bool, Experiment a)] -> [Experiment a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, Experiment a) -> Experiment a
forall a b. (a, b) -> b
snd [(Bool, Experiment a)]
expRes
      if Bool
updated
        then do
          Maybe UTCTime
endT <- UTCTime -> Maybe UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Maybe UTCTime)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
          Key Exps
-> [Update Exps]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update (Experiments a
exp Experiments a
-> Getting (Key Exps) (Experiments a) (Key Exps) -> Key Exps
forall s a. s -> Getting a s a -> a
^. Getting (Key Exps) (Experiments a) (Key Exps)
forall a. Lens' (Experiments a) (Key Exps)
experimentsKey) [EntityField Exps (Maybe UTCTime)
forall typ. (typ ~ Maybe UTCTime) => EntityField Exps typ
ExpsEndTime EntityField Exps (Maybe UTCTime) -> Maybe UTCTime -> Update Exps
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe UTCTime
endT]
          (Bool, Experiments a) -> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
updated, ASetter
  (Experiments a) (Experiments a) [Experiment a] [Experiment a]
-> [Experiment a] -> Experiments a -> Experiments a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Experiments a) (Experiments a) [Experiment a] [Experiment a]
forall a. Lens' (Experiments a) [Experiment a]
experiments [Experiment a]
res (Experiments a -> Experiments a) -> Experiments a -> Experiments a
forall a b. (a -> b) -> a -> b
$ ASetter
  (Experiments a) (Experiments a) (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> Experiments a -> Experiments a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Experiments a) (Experiments a) (Maybe UTCTime) (Maybe UTCTime)
forall a. Lens' (Experiments a) (Maybe UTCTime)
experimentsEndTime Maybe UTCTime
endT Experiments a
exp)
        else (Bool, Experiments a) -> DB (ExpM a) (Bool, Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
updated, ASetter
  (Experiments a) (Experiments a) [Experiment a] [Experiment a]
-> [Experiment a] -> Experiments a -> Experiments a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Experiments a) (Experiments a) [Experiment a] [Experiment a]
forall a. Lens' (Experiments a) [Experiment a]
experiments [Experiment a]
res Experiments a
exp)
  where
    printInfoParamSetup :: ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
printInfoParamSetup = do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"------------------------------"
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"--   INFO PARAMETER SETUP   --"
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"------------------------------"
      if [ExperimentInfoParameter] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Getting
  [ExperimentInfoParameter] (Experiments a) [ExperimentInfoParameter]
-> Experiments a -> [ExperimentInfoParameter]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [ExperimentInfoParameter] (Experiments a) [ExperimentInfoParameter]
forall a. Lens' (Experiments a) [ExperimentInfoParameter]
experimentsInfoParameters Experiments a
exp)
        then $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) Text
"No info parameters set."
        else (ExperimentInfoParameter
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [ExperimentInfoParameter]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExperimentInfoParameter
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *).
MonadLogger m =>
ExperimentInfoParameter -> m ()
printInfoParam (Getting
  [ExperimentInfoParameter] (Experiments a) [ExperimentInfoParameter]
-> Experiments a -> [ExperimentInfoParameter]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [ExperimentInfoParameter] (Experiments a) [ExperimentInfoParameter]
forall a. Lens' (Experiments a) [ExperimentInfoParameter]
experimentsInfoParameters Experiments a
exp)
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"------------------------------"
    printInfoParam :: ExperimentInfoParameter -> m ()
printInfoParam (ExperimentInfoParameter Text
p b
v) = $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> m ()
(Text -> m ()) -> (Text -> Text) -> Text -> m ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. Show a => a -> Text
tshow b
v
    mkRands :: [Experiment a] -> IO Rands
    mkRands :: [Experiment a] -> IO Rands
mkRands [] = do
      [Seed]
prep <- Int -> IO Seed -> IO [Seed]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
repetits (IO (Gen RealWorld)
IO GenIO
createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO Seed) -> IO Seed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save)
      [Seed]
wmUp <- Int -> IO Seed -> IO [Seed]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
repetits Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
replicats) (IO (Gen RealWorld)
IO GenIO
createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO Seed) -> IO Seed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save)
      [Seed]
repl <- Int -> IO Seed -> IO [Seed]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
repetits Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
replicats) (IO (Gen RealWorld)
IO GenIO
createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO Seed) -> IO Seed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save)
      Rands -> IO Rands
forall (m :: * -> *) a. Monad m => a -> m a
return ([Seed]
prep, [Seed]
wmUp, [Seed]
repl)
    mkRands (Experiment a
x:[Experiment a]
_) = do
      [Seed]
currentPrep <- (Gen RealWorld -> IO Seed) -> [Gen RealWorld] -> IO [Seed]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save (Experiment a
x Experiment a
-> Getting (Endo [Gen RealWorld]) (Experiment a) (Gen RealWorld)
-> [Gen RealWorld]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([ExperimentResult a]
 -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> Experiment a -> Const (Endo [Gen RealWorld]) (Experiment a)
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults (([ExperimentResult a]
  -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
 -> Experiment a -> Const (Endo [Gen RealWorld]) (Experiment a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> [ExperimentResult a]
    -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> Getting (Endo [Gen RealWorld]) (Experiment a) (Gen RealWorld)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExperimentResult a
 -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> [ExperimentResult a]
-> Const (Endo [Gen RealWorld]) [ExperimentResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ExperimentResult a
  -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
 -> [ExperimentResult a]
 -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ExperimentResult a
    -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> [ExperimentResult a]
-> Const (Endo [Gen RealWorld]) [ExperimentResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ResultData a)
 -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> ExperimentResult a
-> Const (Endo [Gen RealWorld]) (ExperimentResult a)
forall a. Lens' (ExperimentResult a) (Maybe (ResultData a))
preparationResults ((Maybe (ResultData a)
  -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
 -> ExperimentResult a
 -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> Maybe (ResultData a)
    -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ExperimentResult a
-> Const (Endo [Gen RealWorld]) (ExperimentResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
-> Maybe (ResultData a)
-> Const (Endo [Gen RealWorld]) (Maybe (ResultData a))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
 -> Maybe (ResultData a)
 -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> Maybe (ResultData a)
-> Const (Endo [Gen RealWorld]) (Maybe (ResultData a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a)
forall a. Lens' (ResultData a) GenIO
startRandGen)
      [Seed]
currentWmUp <- (Gen RealWorld -> IO Seed) -> [Gen RealWorld] -> IO [Seed]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save (Experiment a
x Experiment a
-> Getting (Endo [Gen RealWorld]) (Experiment a) (Gen RealWorld)
-> [Gen RealWorld]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([ExperimentResult a]
 -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> Experiment a -> Const (Endo [Gen RealWorld]) (Experiment a)
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults (([ExperimentResult a]
  -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
 -> Experiment a -> Const (Endo [Gen RealWorld]) (Experiment a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> [ExperimentResult a]
    -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> Getting (Endo [Gen RealWorld]) (Experiment a) (Gen RealWorld)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExperimentResult a
 -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> [ExperimentResult a]
-> Const (Endo [Gen RealWorld]) [ExperimentResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ExperimentResult a
  -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
 -> [ExperimentResult a]
 -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ExperimentResult a
    -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> [ExperimentResult a]
-> Const (Endo [Gen RealWorld]) [ExperimentResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ReplicationResult a]
 -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
-> ExperimentResult a
-> Const (Endo [Gen RealWorld]) (ExperimentResult a)
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults (([ReplicationResult a]
  -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
 -> ExperimentResult a
 -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> [ReplicationResult a]
    -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ExperimentResult a
-> Const (Endo [Gen RealWorld]) (ExperimentResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplicationResult a
 -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
-> [ReplicationResult a]
-> Const (Endo [Gen RealWorld]) [ReplicationResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ReplicationResult a
  -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
 -> [ReplicationResult a]
 -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ReplicationResult a
    -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> [ReplicationResult a]
-> Const (Endo [Gen RealWorld]) [ReplicationResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ResultData a)
 -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> ReplicationResult a
-> Const (Endo [Gen RealWorld]) (ReplicationResult a)
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
warmUpResults ((Maybe (ResultData a)
  -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
 -> ReplicationResult a
 -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> Maybe (ResultData a)
    -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ReplicationResult a
-> Const (Endo [Gen RealWorld]) (ReplicationResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
-> Maybe (ResultData a)
-> Const (Endo [Gen RealWorld]) (Maybe (ResultData a))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
 -> Maybe (ResultData a)
 -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> Maybe (ResultData a)
-> Const (Endo [Gen RealWorld]) (Maybe (ResultData a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a)
forall a. Lens' (ResultData a) GenIO
startRandGen)
      [Seed]
currentRepl <- (Gen RealWorld -> IO Seed) -> [Gen RealWorld] -> IO [Seed]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save (Experiment a
x Experiment a
-> Getting (Endo [Gen RealWorld]) (Experiment a) (Gen RealWorld)
-> [Gen RealWorld]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. ([ExperimentResult a]
 -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> Experiment a -> Const (Endo [Gen RealWorld]) (Experiment a)
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults (([ExperimentResult a]
  -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
 -> Experiment a -> Const (Endo [Gen RealWorld]) (Experiment a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> [ExperimentResult a]
    -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> Getting (Endo [Gen RealWorld]) (Experiment a) (Gen RealWorld)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ExperimentResult a
 -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> [ExperimentResult a]
-> Const (Endo [Gen RealWorld]) [ExperimentResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ExperimentResult a
  -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
 -> [ExperimentResult a]
 -> Const (Endo [Gen RealWorld]) [ExperimentResult a])
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ExperimentResult a
    -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> [ExperimentResult a]
-> Const (Endo [Gen RealWorld]) [ExperimentResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ReplicationResult a]
 -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
-> ExperimentResult a
-> Const (Endo [Gen RealWorld]) (ExperimentResult a)
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults (([ReplicationResult a]
  -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
 -> ExperimentResult a
 -> Const (Endo [Gen RealWorld]) (ExperimentResult a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> [ReplicationResult a]
    -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ExperimentResult a
-> Const (Endo [Gen RealWorld]) (ExperimentResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReplicationResult a
 -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
-> [ReplicationResult a]
-> Const (Endo [Gen RealWorld]) [ReplicationResult a]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ReplicationResult a
  -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
 -> [ReplicationResult a]
 -> Const (Endo [Gen RealWorld]) [ReplicationResult a])
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ReplicationResult a
    -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> [ReplicationResult a]
-> Const (Endo [Gen RealWorld]) [ReplicationResult a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (ResultData a)
 -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> ReplicationResult a
-> Const (Endo [Gen RealWorld]) (ReplicationResult a)
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults ((Maybe (ResultData a)
  -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
 -> ReplicationResult a
 -> Const (Endo [Gen RealWorld]) (ReplicationResult a))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> Maybe (ResultData a)
    -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ReplicationResult a
-> Const (Endo [Gen RealWorld]) (ReplicationResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
-> Maybe (ResultData a)
-> Const (Endo [Gen RealWorld]) (Maybe (ResultData a))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
 -> Maybe (ResultData a)
 -> Const (Endo [Gen RealWorld]) (Maybe (ResultData a)))
-> ((Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
    -> ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a))
-> (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> Maybe (ResultData a)
-> Const (Endo [Gen RealWorld]) (Maybe (ResultData a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Gen RealWorld -> Const (Endo [Gen RealWorld]) (Gen RealWorld))
-> ResultData a -> Const (Endo [Gen RealWorld]) (ResultData a)
forall a. Lens' (ResultData a) GenIO
startRandGen)
      [Seed]
prepNew <- Int -> IO Seed -> IO [Seed]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
repetits Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Seed] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Seed]
currentPrep) (IO (Gen RealWorld)
IO GenIO
createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO Seed) -> IO Seed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save)
      [Seed]
wmUpNew <- Int -> IO Seed -> IO [Seed]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
repetits Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
replicats Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Seed] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Seed]
currentWmUp) (IO (Gen RealWorld)
IO GenIO
createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO Seed) -> IO Seed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save)
      [Seed]
replNew <- Int -> IO Seed -> IO [Seed]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
repetits Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
replicats Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Seed] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Seed]
currentRepl) (IO (Gen RealWorld)
IO GenIO
createSystemRandom IO (Gen RealWorld) -> (Gen RealWorld -> IO Seed) -> IO Seed
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Gen RealWorld -> IO Seed
forall (m :: * -> *). PrimMonad m => Gen (PrimState m) -> m Seed
save)
      Rands -> IO Rands
forall (m :: * -> *) a. Monad m => a -> m a
return ([Seed]
currentPrep [Seed] -> [Seed] -> [Seed]
forall a. [a] -> [a] -> [a]
++ [Seed]
prepNew, [Seed]
currentWmUp [Seed] -> [Seed] -> [Seed]
forall a. [a] -> [a] -> [a]
++ [Seed]
wmUpNew, [Seed]
currentRepl [Seed] -> [Seed] -> [Seed]
forall a. [a] -> [a] -> [a]
++ [Seed]
replNew)
    repetits :: Int
repetits = Experiments a
exp Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupRepetitions
    replicats :: Int
replicats = Experiments a
exp Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationReplications

saveParamSettings :: (MonadIO m) =>Key Exp -> [ParameterSetting a] -> DB m ()
saveParamSettings :: Key Exp -> [ParameterSetting a] -> DB m ()
saveParamSettings Key Exp
kExp = (ParameterSetting a
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key ParamSetting))
-> [ParameterSetting a] -> DB m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(ParameterSetting Text
n ConnectionString
bs Bool
drp ExperimentDesign
design) -> ParamSetting
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key ParamSetting)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (ParamSetting
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key ParamSetting))
-> ParamSetting
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key ParamSetting)
forall a b. (a -> b) -> a -> b
$ Key Exp -> Text -> ConnectionString -> Bool -> Int -> ParamSetting
ParamSetting Key Exp
kExp Text
n ConnectionString
bs Bool
drp (ExperimentDesign -> Int
forall a. Enum a => a -> Int
fromEnum ExperimentDesign
design))


initParams :: Experiments a -> [ParameterSetting a]
initParams :: Experiments a -> [ParameterSetting a]
initParams Experiments a
exp = (ParameterSetup a -> ParameterSetting a)
-> [ParameterSetup a] -> [ParameterSetting a]
forall a b. (a -> b) -> [a] -> [b]
map (Experiments a -> ParameterSetup a -> ParameterSetting a
forall a. Experiments a -> ParameterSetup a -> ParameterSetting a
mkParamSetting Experiments a
exp) (Getting [ParameterSetup a] (Experiments a) [ParameterSetup a]
-> Experiments a -> [ParameterSetup a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ParameterSetup a] (Experiments a) [ParameterSetup a]
forall a. Lens' (Experiments a) [ParameterSetup a]
experimentsParameters Experiments a
exp)
  where
    mkParamSetting :: Experiments a -> ParameterSetup a -> ParameterSetting a
    mkParamSetting :: Experiments a -> ParameterSetup a -> ParameterSetting a
mkParamSetting Experiments a
exp' (ParameterSetup Text
name b -> a -> a
_ a -> b
getter Maybe (b -> IO [b])
_ Maybe (b, b)
_ Maybe (b -> Bool)
drp Maybe (b -> ExperimentDesign)
design) =
      let v :: b
v = a -> b
getter (Experiments a
exp' Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState)
      in Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a
forall a1.
Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a1
ParameterSetting Text
name (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter b
forall t. Serialize t => Putter t
put Putter b -> Putter b
forall a b. (a -> b) -> a -> b
$ a -> b
getter (Experiments a
exp' Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState)) (Bool -> ((b -> Bool) -> Bool) -> Maybe (b -> Bool) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\b -> Bool
x -> b -> Bool
x b
v) Maybe (b -> Bool)
drp) (ExperimentDesign
-> ((b -> ExperimentDesign) -> ExperimentDesign)
-> Maybe (b -> ExperimentDesign)
-> ExperimentDesign
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExperimentDesign
FullFactory (\b -> ExperimentDesign
x -> b -> ExperimentDesign
x b
v) Maybe (b -> ExperimentDesign)
design)


mkNoParamExp :: (ExperimentDef a) => Experiments a -> DB (ExpM a) [Experiment a]
mkNoParamExp :: Experiments a -> DB (ExpM a) [Experiment a]
mkNoParamExp Experiments a
exp = do
  $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Initializing new experiment without any parameters..."
  [Entity Exp]
existing <- [Filter Exp]
-> [SelectOpt Exp]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [Entity Exp]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField Exp (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField Exp typ
ExpExps EntityField Exp (Key Exps) -> Key Exps -> Filter Exp
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. (Experiments a
exp Experiments a
-> Getting (Key Exps) (Experiments a) (Key Exps) -> Key Exps
forall s a. s -> Getting a s a -> a
^. Getting (Key Exps) (Experiments a) (Key Exps)
forall a. Lens' (Experiments a) (Key Exps)
experimentsKey)] []
  if Bool -> Bool
not ([Entity Exp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Entity Exp]
existing)
    then [Experiment a] -> DB (ExpM a) [Experiment a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      UTCTime
startT <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      Key Exp
kExp <- Exp -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Exp)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Exp
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Exp))
-> Exp
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Exp)
forall a b. (a -> b) -> a -> b
$ Key Exps -> Int -> UTCTime -> Maybe UTCTime -> Exp
Exp (Experiments a
exp Experiments a
-> Getting (Key Exps) (Experiments a) (Key Exps) -> Key Exps
forall s a. s -> Getting a s a -> a
^. Getting (Key Exps) (Experiments a) (Key Exps)
forall a. Lens' (Experiments a) (Key Exps)
experimentsKey) Int
1 UTCTime
startT Maybe UTCTime
forall a. Maybe a
Nothing
      Key Exp
-> [ParameterSetting a]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a.
MonadIO m =>
Key Exp -> [ParameterSetting a] -> DB m ()
saveParamSettings Key Exp
kExp (Experiments a -> [ParameterSetting a]
forall a. Experiments a -> [ParameterSetting a]
initParams Experiments a
exp)
      [Experiment a] -> DB (ExpM a) [Experiment a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Key Exp
-> Int
-> UTCTime
-> Maybe UTCTime
-> [ParameterSetting a]
-> [ExperimentResult a]
-> Experiment a
forall a.
Key Exp
-> Int
-> UTCTime
-> Maybe UTCTime
-> [ParameterSetting a]
-> [ExperimentResult a]
-> Experiment a
Experiment Key Exp
kExp Int
1 UTCTime
startT Maybe UTCTime
forall a. Maybe a
Nothing (Experiments a -> [ParameterSetting a]
forall a. Experiments a -> [ParameterSetting a]
initParams Experiments a
exp) []]


mkNewExps :: (ExperimentDef a) => Experiments a -> [Experiment a] -> DB (ExpM a) [Experiment a]
mkNewExps :: Experiments a -> [Experiment a] -> DB (ExpM a) [Experiment a]
mkNewExps Experiments a
exp [Experiment a]
expsDone = do
  $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Checking whether adding further experiments is necessary..."
  let params :: [ParameterSetup a]
params = a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters (Experiments a
exp Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState)
  if [ParameterSetup a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ParameterSetup a]
params
    then Experiments a -> DB (ExpM a) [Experiment a]
forall a.
ExperimentDef a =>
Experiments a -> DB (ExpM a) [Experiment a]
mkNoParamExp Experiments a
exp
    else do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Creating new experiment variants"
      UTCTime
startT <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let sortParamSettings :: [[ParameterSetting a1]] -> [[ParameterSetting a1]]
sortParamSettings = ([ParameterSetting a1] -> [ParameterSetting a1])
-> [[ParameterSetting a1]] -> [[ParameterSetting a1]]
forall a b. (a -> b) -> [a] -> [b]
map ((ParameterSetting a1 -> ParameterSetting a1 -> Ordering)
-> [ParameterSetting a1] -> [ParameterSetting a1]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Text -> Text -> Ordering)
-> (ParameterSetting a1 -> Text)
-> ParameterSetting a1
-> ParameterSetting a1
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Getting Text (ParameterSetting a1) Text
-> ParameterSetting a1 -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Text (ParameterSetting a1) Text
forall a1 a2.
Lens (ParameterSetting a1) (ParameterSetting a2) Text Text
parameterSettingName))
      [[ParameterSetting a]]
existParamSettings <- [[ParameterSetting a]] -> [[ParameterSetting a]]
forall a1. [[ParameterSetting a1]] -> [[ParameterSetting a1]]
sortParamSettings ([[ParameterSetting a]] -> [[ParameterSetting a]])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[ParameterSetting a]]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[ParameterSetting a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Experiments a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[ParameterSetting a]]
forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
Experiments a -> DB m [[ParameterSetting a]]
existingParamSettings Experiments a
exp
      --  $(logInfo) $ "Existing Parameter settings: " <> tshow (map (map showVal) $ map (\xs -> zip (L.sortBy (compare `on` parameterName) params) xs) existParamSettings)
      [[ParameterSetting a]]
paramSettings <- (ParameterSetup a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [ParameterSetting a])
-> [ParameterSetup a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [[ParameterSetting a]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Experiments a
-> ParameterSetup a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ParameterSetting a]
forall (m :: * -> *) a.
MonadIO m =>
Experiments a -> ParameterSetup a -> DB m [ParameterSetting a]
mkParamModifications Experiments a
exp) [ParameterSetup a]
params
      let paramCombs :: [[ParameterSetting a]]
paramCombs = [[ParameterSetting a]] -> [[ParameterSetting a]]
forall a. [[a]] -> [[a]]
combinations [[ParameterSetting a]]
paramSettings
      let paramSingleInstances :: [[ParameterSetting a]]
paramSingleInstances = ([ParameterSetting a] -> [ParameterSetting a])
-> [[ParameterSetting a]] -> [[ParameterSetting a]]
forall a b. (a -> b) -> [a] -> [b]
map ((ParameterSetting a -> Bool)
-> [ParameterSetting a] -> [ParameterSetting a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((ExperimentDesign -> ExperimentDesign -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentDesign
SingleInstance) (ExperimentDesign -> Bool)
-> (ParameterSetting a -> ExperimentDesign)
-> ParameterSetting a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting ExperimentDesign (ParameterSetting a) ExperimentDesign
-> ParameterSetting a -> ExperimentDesign
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ExperimentDesign (ParameterSetting a) ExperimentDesign
forall a1 a2.
Lens
  (ParameterSetting a1)
  (ParameterSetting a2)
  ExperimentDesign
  ExperimentDesign
parameterSettingExperimentDesign)) [[ParameterSetting a]]
paramSettings
      let settings :: [[ParameterSetting a]]
settings = ([ParameterSetting a] -> Bool)
-> [[ParameterSetting a]] -> [[ParameterSetting a]]
forall a. (a -> Bool) -> [a] -> [a]
filter ([ParameterSetting a] -> [[ParameterSetting a]] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [[ParameterSetting a]]
existParamSettings) ([[ParameterSetting a]] -> [[ParameterSetting a]])
-> [[ParameterSetting a]] -> [[ParameterSetting a]]
forall a b. (a -> b) -> a -> b
$ [[ParameterSetting a]] -> [[ParameterSetting a]]
forall a1. [[ParameterSetting a1]] -> [[ParameterSetting a1]]
sortParamSettings ([[ParameterSetting a]] -> [[ParameterSetting a]])
-> [[ParameterSetting a]] -> [[ParameterSetting a]]
forall a b. (a -> b) -> a -> b
$ ([[ParameterSetting a]]
 -> ParameterSetting a -> [[ParameterSetting a]])
-> [[ParameterSetting a]]
-> [ParameterSetting a]
-> [[ParameterSetting a]]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [[ParameterSetting a]]
-> ParameterSetting a -> [[ParameterSetting a]]
forall (t :: * -> *) a. (Foldable t, Eq a) => [t a] -> a -> [t a]
mkSingleInstance [[ParameterSetting a]]
paramCombs ([[ParameterSetting a]] -> [ParameterSetting a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ParameterSetting a]]
paramSingleInstances)
          mkSingleInstance :: [t a] -> a -> [t a]
mkSingleInstance [t a]
combs a
param =
            let occurrences :: [t a]
occurrences = (t a -> Bool) -> [t a] -> [t a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a
param a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [t a]
combs
                noOccurances :: [t a]
noOccurances = (t a -> Bool) -> [t a] -> [t a]
forall a. (a -> Bool) -> [a] -> [a]
filter (a
param a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`) [t a]
combs
             in [t a]
noOccurances [t a] -> [t a] -> [t a]
forall a. [a] -> [a] -> [a]
++ Int -> [t a] -> [t a]
forall a. Int -> [a] -> [a]
take Int
1 [t a]
occurrences
      let nrs :: [Int]
nrs = [Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Experiment a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Experiment a]
expsDone .. [Experiment a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Experiment a]
expsDone Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [[ParameterSetting a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ParameterSetting a]]
settings]
      [Key Exp]
kExps <- (Int
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Exp))
-> [Int]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) [Key Exp]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Int
nr -> Exp -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Exp)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (Exp
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Exp))
-> Exp
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Key Exp)
forall a b. (a -> b) -> a -> b
$ Key Exps -> Int -> UTCTime -> Maybe UTCTime -> Exp
Exp (Experiments a
exp Experiments a
-> Getting (Key Exps) (Experiments a) (Key Exps) -> Key Exps
forall s a. s -> Getting a s a -> a
^. Getting (Key Exps) (Experiments a) (Key Exps)
forall a. Lens' (Experiments a) (Key Exps)
experimentsKey) Int
nr UTCTime
startT Maybe UTCTime
forall a. Maybe a
Nothing) [Int]
nrs
      (Key Exp
 -> [ParameterSetting a]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [Key Exp]
-> [[ParameterSetting a]]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ Key Exp
-> [ParameterSetting a]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a.
MonadIO m =>
Key Exp -> [ParameterSetting a] -> DB m ()
saveParamSettings [Key Exp]
kExps [[ParameterSetting a]]
settings
      let exps :: [Experiment a]
exps = (Key Exp -> Int -> [ParameterSetting a] -> Experiment a)
-> [Key Exp] -> [Int] -> [[ParameterSetting a]] -> [Experiment a]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 (\Key Exp
key Int
nr [ParameterSetting a]
parms -> Key Exp
-> Int
-> UTCTime
-> Maybe UTCTime
-> [ParameterSetting a]
-> [ExperimentResult a]
-> Experiment a
forall a.
Key Exp
-> Int
-> UTCTime
-> Maybe UTCTime
-> [ParameterSetting a]
-> [ExperimentResult a]
-> Experiment a
Experiment Key Exp
key Int
nr UTCTime
startT Maybe UTCTime
forall a. Maybe a
Nothing [ParameterSetting a]
parms []) [Key Exp]
kExps [Int]
nrs [[ParameterSetting a]]
settings
      Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Experiment a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Experiment a]
exps) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Created " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([Experiment a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Experiment a]
exps) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" new experiments variations!"
      ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
      [Experiment a] -> DB (ExpM a) [Experiment a]
forall (m :: * -> *) a. Monad m => a -> m a
return [Experiment a]
exps


combinations :: [[a]] -> [[a]]
combinations :: [[a]] -> [[a]]
combinations []       = []
combinations [[a]
xs] = (a -> [a]) -> [a] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs
combinations ([a]
xs:[[a]]
xss) = (a -> [[a]]) -> [a] -> [[a]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [[a]]
ys) [a]
xs
  where ys :: [[a]]
ys = [[a]] -> [[a]]
forall a. [[a]] -> [[a]]
combinations [[a]]
xss


mkParamModifications :: (MonadIO m) => Experiments a -> ParameterSetup a -> DB m [ParameterSetting a]
mkParamModifications :: Experiments a -> ParameterSetup a -> DB m [ParameterSetting a]
mkParamModifications Experiments a
exps setup :: ParameterSetup a
setup@(ParameterSetup Text
n b -> a -> a
_ a -> b
getter Maybe (b -> IO [b])
_ Maybe (b, b)
_ Maybe (b -> Bool)
drp Maybe (b -> ExperimentDesign)
design) = ParameterSetup a
-> [ParameterSetting a]
-> ParameterSetting a
-> DB m [ParameterSetting a]
forall (m :: * -> *) a.
MonadIO m =>
ParameterSetup a
-> [ParameterSetting a]
-> ParameterSetting a
-> DB m [ParameterSetting a]
modifyParam ParameterSetup a
setup [] (Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a
forall a1.
Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a1
ParameterSetting Text
n ConnectionString
bs (Bool -> ((b -> Bool) -> Bool) -> Maybe (b -> Bool) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\b -> Bool
x -> b -> Bool
x b
v) Maybe (b -> Bool)
drp) (ExperimentDesign
-> ((b -> ExperimentDesign) -> ExperimentDesign)
-> Maybe (b -> ExperimentDesign)
-> ExperimentDesign
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExperimentDesign
FullFactory (\b -> ExperimentDesign
x -> b -> ExperimentDesign
x b
v) Maybe (b -> ExperimentDesign)
design))
  where v :: b
v = a -> b
getter (Experiments a
exps Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState)
        bs :: ConnectionString
bs = Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter b
forall t. Serialize t => Putter t
put b
v

modifyParam :: (MonadIO m) => ParameterSetup a -> [ParameterSetting a] -> ParameterSetting a -> DB m [ParameterSetting a]
modifyParam :: ParameterSetup a
-> [ParameterSetting a]
-> ParameterSetting a
-> DB m [ParameterSetting a]
modifyParam (ParameterSetup Text
_ b -> a -> a
_ a -> b
_ Maybe (b -> IO [b])
Nothing Maybe (b, b)
_ Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_) ![ParameterSetting a]
_ !ParameterSetting a
sett = [ParameterSetting a] -> DB m [ParameterSetting a]
forall (m :: * -> *) a. Monad m => a -> m a
return [ParameterSetting a
sett]
modifyParam setup :: ParameterSetup a
setup@(ParameterSetup Text
n b -> a -> a
_ a -> b
_ (Just b -> IO [b]
modifier) Maybe (b, b)
mBounds Maybe (b -> Bool)
drp Maybe (b -> ExperimentDesign)
design) ![ParameterSetting a]
acc !ParameterSetting a
sett = do
  case Get b -> ConnectionString -> Either String b
forall a. Get a -> ConnectionString -> Either String a
S.runGet Get b
forall t. Serialize t => Get t
S.get (Getting ConnectionString (ParameterSetting a) ConnectionString
-> ParameterSetting a -> ConnectionString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ConnectionString (ParameterSetting a) ConnectionString
forall a1 a2.
Lens
  (ParameterSetting a1)
  (ParameterSetting a2)
  ConnectionString
  ConnectionString
parameterSettingValue ParameterSetting a
sett) of
    Left String
err -> String -> DB m [ParameterSetting a]
forall a. HasCallStack => String -> a
error (String -> DB m [ParameterSetting a])
-> String -> DB m [ParameterSetting a]
forall a b. (a -> b) -> a -> b
$ String
"Could not deserialize a value for parameter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". Cannot proceed! The error was: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>  String
err
    Right b
val -> do
      let filterBounds :: b -> Bool
filterBounds b
x =
            case Maybe (b, b)
mBounds of
              Maybe (b, b)
Nothing           -> Bool
True
              Just (b
minB, b
maxB) -> b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
<= b
maxB Bool -> Bool -> Bool
&& b
x b -> b -> Bool
forall a. Ord a => a -> a -> Bool
>= b
minB
          filterExperimentDesign :: [(b, ConnectionString)] -> [(b, ConnectionString)]
filterExperimentDesign [(b, ConnectionString)]
xs = ([(b, ConnectionString)] -> [(b, ConnectionString)])
-> [[(b, ConnectionString)]] -> [(b, ConnectionString)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [(b, ConnectionString)] -> [(b, ConnectionString)]
filt' ([[(b, ConnectionString)]] -> [(b, ConnectionString)])
-> [[(b, ConnectionString)]] -> [(b, ConnectionString)]
forall a b. (a -> b) -> a -> b
$ ((b, ConnectionString) -> (b, ConnectionString) -> Bool)
-> [(b, ConnectionString)] -> [[(b, ConnectionString)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool)
-> ((b, ConnectionString) -> b)
-> (b, ConnectionString)
-> (b, ConnectionString)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (b, ConnectionString) -> b
forall a b. (a, b) -> a
fst) ([(b, ConnectionString)] -> [[(b, ConnectionString)]])
-> [(b, ConnectionString)] -> [[(b, ConnectionString)]]
forall a b. (a -> b) -> a -> b
$ ((b, ConnectionString) -> (b, ConnectionString) -> Ordering)
-> [(b, ConnectionString)] -> [(b, ConnectionString)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (b -> b -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (b -> b -> Ordering)
-> ((b, ConnectionString) -> b)
-> (b, ConnectionString)
-> (b, ConnectionString)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (b, ConnectionString) -> b
forall a b. (a, b) -> a
fst) [(b, ConnectionString)]
xs
          filt' :: [(b, ConnectionString)] -> [(b, ConnectionString)]
filt' xs :: [(b, ConnectionString)]
xs@((b
v, ConnectionString
_):[(b, ConnectionString)]
_) =
            case Maybe (b -> ExperimentDesign)
design of
              Just b -> ExperimentDesign
dsgn
                | b -> ExperimentDesign
dsgn b
v ExperimentDesign -> ExperimentDesign -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentDesign
SingleInstance -> Int -> [(b, ConnectionString)] -> [(b, ConnectionString)]
forall a. Int -> [a] -> [a]
take Int
1 [(b, ConnectionString)]
xs
              Maybe (b -> ExperimentDesign)
_ -> [(b, ConnectionString)]
xs
          filt' [(b, ConnectionString)]
_ = String -> [(b, ConnectionString)]
forall a. HasCallStack => String -> a
error String
"Empty list in filt', e.g. in filtering of the experiments design, in modifyParam in Run.hs"
      [(b, ConnectionString)]
bss <- IO [(b, ConnectionString)]
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [(b, ConnectionString)]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(b, ConnectionString)]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT m)) [(b, ConnectionString)])
-> IO [(b, ConnectionString)]
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [(b, ConnectionString)]
forall a b. (a -> b) -> a -> b
$ [(b, ConnectionString)] -> [(b, ConnectionString)]
filterExperimentDesign ([(b, ConnectionString)] -> [(b, ConnectionString)])
-> ([b] -> [(b, ConnectionString)])
-> [b]
-> [(b, ConnectionString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> (b, ConnectionString)) -> [b] -> [(b, ConnectionString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> b
forall a. a -> a
id (b -> b) -> (b -> ConnectionString) -> b -> (b, ConnectionString)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Put -> ConnectionString
runPut (Put -> ConnectionString) -> (b -> Put) -> b -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Put
forall t. Serialize t => Putter t
put) ([b] -> [(b, ConnectionString)])
-> ([b] -> [b]) -> [b] -> [(b, ConnectionString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Bool) -> [b] -> [b]
forall a. (a -> Bool) -> [a] -> [a]
filter b -> Bool
filterBounds ([b] -> [(b, ConnectionString)])
-> IO [b] -> IO [(b, ConnectionString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> b -> IO [b]
modifier b
val
      let params' :: [ParameterSetting a]
params' = (ParameterSetting a -> Bool)
-> [ParameterSetting a] -> [ParameterSetting a]
forall a. (a -> Bool) -> [a] -> [a]
filter (ParameterSetting a -> [ParameterSetting a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [ParameterSetting a]
acc) ([ParameterSetting a] -> [ParameterSetting a])
-> [ParameterSetting a] -> [ParameterSetting a]
forall a b. (a -> b) -> a -> b
$ ((b, ConnectionString) -> ParameterSetting a)
-> [(b, ConnectionString)] -> [ParameterSetting a]
forall a b. (a -> b) -> [a] -> [b]
map (\(b
v, ConnectionString
bs) -> Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a
forall a1.
Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a1
ParameterSetting Text
n ConnectionString
bs (Bool -> ((b -> Bool) -> Bool) -> Maybe (b -> Bool) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\b -> Bool
x -> b -> Bool
x b
v) Maybe (b -> Bool)
drp) (ExperimentDesign
-> ((b -> ExperimentDesign) -> ExperimentDesign)
-> Maybe (b -> ExperimentDesign)
-> ExperimentDesign
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ExperimentDesign
FullFactory (\b -> ExperimentDesign
x -> b -> ExperimentDesign
x b
v) Maybe (b -> ExperimentDesign)
design)) [(b, ConnectionString)]
bss
      ([ParameterSetting a]
 -> ParameterSetting a -> DB m [ParameterSetting a])
-> [ParameterSetting a]
-> [ParameterSetting a]
-> DB m [ParameterSetting a]
forall a (m :: * -> *) b.
(NFData a, Monad m) =>
(a -> b -> m a) -> a -> [b] -> m a
foldM' (ParameterSetup a
-> [ParameterSetting a]
-> ParameterSetting a
-> DB m [ParameterSetting a]
forall (m :: * -> *) a.
MonadIO m =>
ParameterSetup a
-> [ParameterSetting a]
-> ParameterSetting a
-> DB m [ParameterSetting a]
modifyParam ParameterSetup a
setup) ([ParameterSetting a]
acc [ParameterSetting a]
-> [ParameterSetting a] -> [ParameterSetting a]
forall a. [a] -> [a] -> [a]
++ [ParameterSetting a]
params') [ParameterSetting a]
params'


existingParamSettings :: (ExperimentDef a, MonadIO m) => Experiments a -> DB m [[ParameterSetting a]]
existingParamSettings :: Experiments a -> DB m [[ParameterSetting a]]
existingParamSettings Experiments a
exp = do
  let params :: [ParameterSetup a]
params = a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters (Experiments a
exp Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState)
  [Key Exp]
expIds <- [Filter Exp]
-> [SelectOpt Exp]
-> ReaderT SqlBackend (LoggingT (ResourceT m)) [Key Exp]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Key record]
selectKeysList [EntityField Exp (Key Exps)
forall typ. (typ ~ Key Exps) => EntityField Exp typ
ExpExps EntityField Exp (Key Exps) -> Key Exps -> Filter Exp
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Experiments a
exp Experiments a
-> Getting (Key Exps) (Experiments a) (Key Exps) -> Key Exps
forall s a. s -> Getting a s a -> a
^. Getting (Key Exps) (Experiments a) (Key Exps)
forall a. Lens' (Experiments a) (Key Exps)
experimentsKey] []
  ([Entity ParamSetting] -> [ParameterSetting a])
-> [[Entity ParamSetting]] -> [[ParameterSetting a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Entity ParamSetting -> [ParameterSetting a])
-> [Entity ParamSetting] -> [ParameterSetting a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([ParameterSetup a] -> ParamSetting -> [ParameterSetting a]
forall (t :: * -> *) a a.
Foldable t =>
t (ParameterSetup a) -> ParamSetting -> [ParameterSetting a]
toParameterSetting [ParameterSetup a]
params (ParamSetting -> [ParameterSetting a])
-> (Entity ParamSetting -> ParamSetting)
-> Entity ParamSetting
-> [ParameterSetting a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Entity ParamSetting -> ParamSetting
forall record. Entity record -> record
entityVal)) ([[Entity ParamSetting]] -> [[ParameterSetting a]])
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [[Entity ParamSetting]]
-> DB m [[ParameterSetting a]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key Exp
 -> ReaderT
      SqlBackend (LoggingT (ResourceT m)) [Entity ParamSetting])
-> [Key Exp]
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [[Entity ParamSetting]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\Key Exp
e -> [Filter ParamSetting]
-> [SelectOpt ParamSetting]
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) [Entity ParamSetting]
forall record backend (m :: * -> *).
(MonadIO m, PersistQueryRead backend,
 PersistRecordBackend record backend) =>
[Filter record]
-> [SelectOpt record] -> ReaderT backend m [Entity record]
selectList [EntityField ParamSetting (Key Exp)
forall typ. (typ ~ Key Exp) => EntityField ParamSetting typ
ParamSettingExp EntityField ParamSetting (Key Exp)
-> Key Exp -> Filter ParamSetting
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key Exp
e] []) [Key Exp]
expIds
  where
    toParameterSetting :: t (ParameterSetup a) -> ParamSetting -> [ParameterSetting a]
toParameterSetting t (ParameterSetup a)
params (ParamSetting Key Exp
_ Text
n ConnectionString
vBs Bool
drp Int
dsgn) =
      case (ParameterSetup a -> Bool)
-> t (ParameterSetup a) -> Maybe (ParameterSetup a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) (Text -> Bool)
-> (ParameterSetup a -> Text) -> ParameterSetup a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterSetup a -> Text
forall a. ParameterSetup a -> Text
parameterName) t (ParameterSetup a)
params of
        Maybe (ParameterSetup a)
Nothing -> []
        Maybe (ParameterSetup a)
_       -> [Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a
forall a1.
Text
-> ConnectionString
-> Bool
-> ExperimentDesign
-> ParameterSetting a1
ParameterSetting Text
n ConnectionString
vBs Bool
drp (Int -> ExperimentDesign
forall a. Enum a => Int -> a
toEnum Int
dsgn)]

-- deleteExperiment :: (MonadIO m) => Experiment a -> DB m ()
-- deleteExperiment (Experiment k _ _ _ _ expRes) = mapM_ deleteExperimentResult expRes >> deleteCascade k


deleteExperimentResult :: (MonadIO m) => ExperimentResult a -> DB m ()
deleteExperimentResult :: ExperimentResult a -> DB m ()
deleteExperimentResult (ExperimentResult Key ExpResult
k Int
_ Maybe (ResultData a)
_ [ReplicationResult a]
repls) = (ReplicationResult a -> DB m ())
-> [ReplicationResult a] -> DB m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ReplicationResult a -> DB m ()
forall (m :: * -> *) a. MonadIO m => ReplicationResult a -> DB m ()
deleteReplicationResult [ReplicationResult a]
repls DB m () -> DB m () -> DB m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Key ExpResult -> DB m ()
forall record backend (m :: * -> *).
(DeleteCascade record backend, MonadIO m) =>
Key record -> ReaderT backend m ()
deleteCascade Key ExpResult
k


-- | Loads parameters of an experiment into all initial and end states of the given experiments variable.
loadParameters  :: (ExperimentDef a) => Experiments a -> Experiment a  -> DB (ExpM a) (Experiments a)
loadParameters :: Experiments a -> Experiment a -> DB (ExpM a) (Experiments a)
loadParameters Experiments a
exps Experiment a
exp = (Experiments a
 -> ParameterSetting a -> DB (ExpM a) (Experiments a))
-> Experiments a
-> [ParameterSetting a]
-> DB (ExpM a) (Experiments a)
forall a (m :: * -> *) b.
(NFData a, Monad m) =>
(a -> b -> m a) -> a -> [b] -> m a
foldM' Experiments a -> ParameterSetting a -> DB (ExpM a) (Experiments a)
setParam Experiments a
exps (Experiment a
exp Experiment a
-> Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
-> [ParameterSetting a]
forall s a. s -> Getting a s a -> a
^. Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
forall a. Lens' (Experiment a) [ParameterSetting a]
parameterSetup)
  where
    setParam :: Experiments a -> ParameterSetting a -> DB (ExpM a) (Experiments a)
setParam Experiments a
e (ParameterSetting Text
n ConnectionString
bs Bool
_ ExperimentDesign
_) =
      case (ParameterSetup a -> Bool)
-> [ParameterSetup a] -> Maybe (ParameterSetup a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (\(ParameterSetup Text
name b -> a -> a
_ a -> b
_ Maybe (b -> IO [b])
_ Maybe (b, b)
_ Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_) -> Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) [ParameterSetup a]
parameterSetups of
        Maybe (ParameterSetup a)
Nothing -> do
          $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logError) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Could not find parameter with name " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" in the current parameter setting. Thus it cannot be modified!"
          Experiments a -> DB (ExpM a) (Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return Experiments a
e
        Just (ParameterSetup Text
_ b -> a -> a
setter a -> b
_ Maybe (b -> IO [b])
_ Maybe (b, b)
_ Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_) ->
          case Get b -> ConnectionString -> Either String b
forall a. Get a -> ConnectionString -> Either String a
runGet Get b
forall t. Serialize t => Get t
S.get ConnectionString
bs of
            Left String
err -> String -> DB (ExpM a) (Experiments a)
forall a. HasCallStack => String -> a
error (String -> DB (ExpM a) (Experiments a))
-> String -> DB (ExpM a) (Experiments a)
forall a b. (a -> b) -> a -> b
$ String
"Could not read value of parameter " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". Aborting! Serializtion error was: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err
            Right b
val -> do
              $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Loaded parameter '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. Show a => a -> Text
tshow b
val
              Experiments a -> DB (ExpM a) (Experiments a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Experiments a -> DB (ExpM a) (Experiments a))
-> Experiments a -> DB (ExpM a) (Experiments a)
forall a b. (a -> b) -> a -> b
$ ASetter (Experiments a) (Experiments a) a a
-> (a -> a) -> Experiments a -> Experiments a
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Experiments a) (Experiments a) a a
forall a. Lens' (Experiments a) a
experimentsInitialState (b -> a -> a
setter b
val) Experiments a
e
    parameterSetups :: [ParameterSetup a]
parameterSetups = a -> [ParameterSetup a]
forall a. ExperimentDef a => a -> [ParameterSetup a]
parameters (Experiments a
exps Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState)


continueExperiment :: (ExperimentDef a) => DatabaseSetting -> Rands -> Experiments a -> Experiment a  -> DB (ExpM a) (Updated, Experiment a)
continueExperiment :: DatabaseSetting
-> Rands
-> Experiments a
-> Experiment a
-> DB (ExpM a) (Bool, Experiment a)
continueExperiment DatabaseSetting
dbSetup Rands
rands Experiments a
exps Experiment a
expIn = do
  ProcessID
pid <- IO ProcessID
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ProcessID
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ProcessID
getProcessID
  String
hostName <- IO String
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getHostName
  UTCTime
time <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  [Filter ExpExecutionLock]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend (m :: * -> *) record.
(PersistQueryWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[Filter record] -> ReaderT backend m ()
deleteWhere [EntityField ExpExecutionLock UTCTime
forall typ. (typ ~ UTCTime) => EntityField ExpExecutionLock typ
ExpExecutionLockLastAliveSign EntityField ExpExecutionLock UTCTime
-> UTCTime -> Filter ExpExecutionLock
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
<=. NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (-NominalDiffTime
2 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime
forall t. Num t => t
keepAliveTimeout) UTCTime
time]
  Maybe (Key ExpExecutionLock)
maybeLocked <- ExpExecutionLock
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Key ExpExecutionLock))
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Maybe (Key record))
insertUnique (ExpExecutionLock
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Key ExpExecutionLock)))
-> ExpExecutionLock
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Maybe (Key ExpExecutionLock))
forall a b. (a -> b) -> a -> b
$ Key Exp -> Text -> Int -> UTCTime -> ExpExecutionLock
ExpExecutionLock Key Exp
expId (String -> Text
T.pack String
hostName) (ProcessID -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ProcessID
pid) UTCTime
time
  ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
  case Maybe (Key ExpExecutionLock)
maybeLocked of
    Maybe (Key ExpExecutionLock)
Nothing -> do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Skipping experiment with ID " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (Key Exp -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey Key Exp
expId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" as it is currently locked by another worker."
      (Bool, Experiment a) -> DB (ExpM a) (Bool, Experiment a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Experiment a
expIn)
    Just Key ExpExecutionLock
lock -> do
      [ExperimentResult a]
expResults <- Key Exp
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
forall a.
ExperimentDef a =>
Key Exp -> DB (ExpM a) [ExperimentResult a]
loadExperimentResults Key Exp
expId -- update data
      let exp :: Experiment a
exp = ASetter
  (Experiment a)
  (Experiment a)
  [ExperimentResult a]
  [ExperimentResult a]
-> [ExperimentResult a] -> Experiment a -> Experiment a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Experiment a)
  (Experiment a)
  [ExperimentResult a]
  [ExperimentResult a]
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults [ExperimentResult a]
expResults Experiment a
expIn
      Experiment a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
printParamSetup Experiment a
exp
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Processing experiment with ID " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (Key Exp -> Int64
forall record.
ToBackendKey SqlBackend record =>
Key record -> Int64
fromSqlKey Key Exp
expId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
      IORef WorkerStatus
ref <- IO (IORef WorkerStatus)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (IORef WorkerStatus)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef WorkerStatus)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (IORef WorkerStatus))
-> IO (IORef WorkerStatus)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (IORef WorkerStatus)
forall a b. (a -> b) -> a -> b
$ DatabaseSetting
-> (UTCTime -> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ())
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
-> IO (IORef WorkerStatus)
createKeepAliveFork DatabaseSetting
dbSetup (\UTCTime
t -> Key ExpExecutionLock
-> [Update ExpExecutionLock]
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key ExpExecutionLock
lock [EntityField ExpExecutionLock UTCTime
forall typ. (typ ~ UTCTime) => EntityField ExpExecutionLock typ
ExpExecutionLockLastAliveSign EntityField ExpExecutionLock UTCTime
-> UTCTime -> Update ExpExecutionLock
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. UTCTime
t]) (Key ExpExecutionLock
-> ReaderT SqlBackend (NoLoggingT (ResourceT IO)) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key ExpExecutionLock
lock)
      IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef WorkerStatus -> WorkerStatus -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef WorkerStatus
ref WorkerStatus
Working)
      Experiments a
exps' <- Experiments a
-> Experiment a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Experiments a)
forall a.
ExperimentDef a =>
Experiments a -> Experiment a -> DB (ExpM a) (Experiments a)
loadParameters Experiments a
exps Experiment a
exp -- loads parameters into the init state
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Checking if new experiments repetitions can be created"
      ![ExperimentResult a]
expResList <- [ExperimentResult a] -> [ExperimentResult a]
forall a. NFData a => a -> a
force ([ExperimentResult a] -> [ExperimentResult a])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ExperimentResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
forall (m :: * -> *) a.
MonadIO m =>
[ExperimentResult a] -> DB m [ExperimentResult a]
getExpRes (Experiment a
exp Experiment a
-> Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
-> [ExperimentResult a]
forall s a. s -> Getting a s a -> a
^. Getting [ExperimentResult a] (Experiment a) [ExperimentResult a]
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults) ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
-> ([ExperimentResult a]
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a])
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int
-> [ExperimentResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ExperimentResult a]
forall (m :: * -> *) a.
MonadIO m =>
Int
-> [ExperimentResult a]
-> ReaderT SqlBackend (LoggingT (ResourceT m)) [ExperimentResult a]
truncateExperiments Int
repetits)
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Number of experiment repetition results loaded: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([ExperimentResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExperimentResult a]
expResList)
      let skipPrep :: Bool
skipPrep = (ParameterSetting a -> Bool) -> [ParameterSetting a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ParameterSetting a
-> Getting Bool (ParameterSetting a) Bool -> Bool
forall s a. s -> Getting a s a -> a
^. Getting Bool (ParameterSetting a) Bool
forall a1 a2.
Lens (ParameterSetting a1) (ParameterSetting a2) Bool Bool
parameterSettingSkipPreparationPhase) (Experiment a
exp Experiment a
-> Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
-> [ParameterSetting a]
forall s a. s -> Getting a s a -> a
^. Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
forall a. Lens' (Experiment a) [ParameterSetting a]
parameterSetup)
      [(Bool, ExperimentResult a)]
expRes <- [(Bool, ExperimentResult a)] -> [(Bool, ExperimentResult a)]
forall a. NFData a => a -> a
force ([(Bool, ExperimentResult a)] -> [(Bool, ExperimentResult a)])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [(Bool, ExperimentResult a)]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [(Bool, ExperimentResult a)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExperimentResult a
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Bool, ExperimentResult a))
-> [ExperimentResult a]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [(Bool, ExperimentResult a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Bool
-> Rands
-> Experiments a
-> Key Exp
-> Int
-> ExperimentResult a
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, ExperimentResult a)
forall a.
ExperimentDef a =>
Bool
-> Rands
-> Experiments a
-> Key Exp
-> Int
-> ExperimentResult a
-> DB (ExpM a) (Bool, ExperimentResult a)
runExperimentResult Bool
skipPrep Rands
rands Experiments a
exps' Key Exp
expId Int
expNr) [ExperimentResult a]
expResList
      let updated :: Bool
updated = ((Bool, ExperimentResult a) -> Bool)
-> [(Bool, ExperimentResult a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, ExperimentResult a) -> Bool
forall a b. (a, b) -> a
fst [(Bool, ExperimentResult a)]
expRes
          res :: [ExperimentResult a]
res = ((Bool, ExperimentResult a) -> ExperimentResult a)
-> [(Bool, ExperimentResult a)] -> [ExperimentResult a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, ExperimentResult a) -> ExperimentResult a
forall a b. (a, b) -> b
snd [(Bool, ExperimentResult a)]
expRes
      [(Bool, ExperimentResult a)]
expRes [(Bool, ExperimentResult a)]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
`seq` IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IORef WorkerStatus -> WorkerStatus -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef WorkerStatus
ref WorkerStatus
Finished)
      if Bool
updated
        then do
          Maybe UTCTime
eTime <- UTCTime -> Maybe UTCTime
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime -> Maybe UTCTime)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
          Key Exp
-> [Update Exp]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update (Experiment a
exp Experiment a
-> Getting (Key Exp) (Experiment a) (Key Exp) -> Key Exp
forall s a. s -> Getting a s a -> a
^. Getting (Key Exp) (Experiment a) (Key Exp)
forall a. Lens' (Experiment a) (Key Exp)
experimentKey) [EntityField Exp (Maybe UTCTime)
forall typ. (typ ~ Maybe UTCTime) => EntityField Exp typ
ExpEndTime EntityField Exp (Maybe UTCTime) -> Maybe UTCTime -> Update Exp
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe UTCTime
eTime]
          Key ExpExecutionLock
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key ExpExecutionLock
lock
          (Bool, Experiment a) -> DB (ExpM a) (Bool, Experiment a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
updated, ASetter
  (Experiment a)
  (Experiment a)
  [ExperimentResult a]
  [ExperimentResult a]
-> [ExperimentResult a] -> Experiment a -> Experiment a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Experiment a)
  (Experiment a)
  [ExperimentResult a]
  [ExperimentResult a]
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults [ExperimentResult a]
res (Experiment a -> Experiment a) -> Experiment a -> Experiment a
forall a b. (a -> b) -> a -> b
$ ASetter
  (Experiment a) (Experiment a) (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> Experiment a -> Experiment a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Experiment a) (Experiment a) (Maybe UTCTime) (Maybe UTCTime)
forall a. Lens' (Experiment a) (Maybe UTCTime)
experimentEndTime Maybe UTCTime
eTime Experiment a
exp)
        else Key ExpExecutionLock
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m ()
delete Key ExpExecutionLock
lock ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> DB (ExpM a) (Bool, Experiment a)
-> DB (ExpM a) (Bool, Experiment a)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Bool, Experiment a) -> DB (ExpM a) (Bool, Experiment a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
updated, ASetter
  (Experiment a)
  (Experiment a)
  [ExperimentResult a]
  [ExperimentResult a]
-> [ExperimentResult a] -> Experiment a -> Experiment a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (Experiment a)
  (Experiment a)
  [ExperimentResult a]
  [ExperimentResult a]
forall a. Lens' (Experiment a) [ExperimentResult a]
experimentResults [ExperimentResult a]
res Experiment a
exp)
  where
    printParamSetup :: Experiment a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
printParamSetup Experiment a
exp = do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"------------------------------"
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"--  LOADED PARAMETER SETUP  --"
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"------------------------------"
      if [ParameterSetting a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
-> Experiment a -> [ParameterSetting a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
forall a. Lens' (Experiment a) [ParameterSetting a]
parameterSetup Experiment a
expIn)
        then $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logDebug) Text
"No info parameters set."
        else (ParameterSetting a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [ParameterSetting a]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Experiments a
-> ParameterSetting a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a.
ExperimentDef a =>
Experiments a -> ParameterSetting a -> DB (ExpM a) ()
printParamSetting Experiments a
exps) (Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
-> Experiment a -> [ParameterSetting a]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [ParameterSetting a] (Experiment a) [ParameterSetting a]
forall a. Lens' (Experiment a) [ParameterSetting a]
parameterSetup Experiment a
exp)
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"------------------------------"
    expNr :: Int
expNr = Experiment a
expIn Experiment a -> Getting Int (Experiment a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (Experiment a) Int
forall a. Lens' (Experiment a) Int
experimentNumber
    expId :: Key Exp
expId = Experiment a
expIn Experiment a
-> Getting (Key Exp) (Experiment a) (Key Exp) -> Key Exp
forall s a. s -> Getting a s a -> a
^. Getting (Key Exp) (Experiment a) (Key Exp)
forall a. Lens' (Experiment a) (Key Exp)
experimentKey
    repetits :: Int
repetits = Experiments a
exps Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupRepetitions
    getExpRes :: (MonadIO m) => [ExperimentResult a] -> DB m [ExperimentResult a]
    getExpRes :: [ExperimentResult a] -> DB m [ExperimentResult a]
getExpRes [ExperimentResult a]
expResDone =
      ([ExperimentResult a]
expResDone [ExperimentResult a]
-> [ExperimentResult a] -> [ExperimentResult a]
forall a. [a] -> [a] -> [a]
++) ([ExperimentResult a] -> [ExperimentResult a])
-> DB m [ExperimentResult a] -> DB m [ExperimentResult a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      [Int]
-> (Int
    -> ReaderT
         SqlBackend (LoggingT (ResourceT m)) (ExperimentResult a))
-> DB m [ExperimentResult a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
        [[ExperimentResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExperimentResult a]
expResDone Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Int
repetits]
        (\Int
nr -> do
           Key ExpResult
kExpRes <- ExpResult
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key ExpResult)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (ExpResult
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key ExpResult))
-> ExpResult
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key ExpResult)
forall a b. (a -> b) -> a -> b
$ Key Exp -> Int -> Maybe (Key PrepResultData) -> ExpResult
ExpResult Key Exp
expId Int
nr Maybe (Key PrepResultData)
forall a. Maybe a
Nothing
           ExperimentResult a
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (ExperimentResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ExperimentResult a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT m)) (ExperimentResult a))
-> ExperimentResult a
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (ExperimentResult a)
forall a b. (a -> b) -> a -> b
$ Key ExpResult
-> Int
-> Maybe (ResultData a)
-> [ReplicationResult a]
-> ExperimentResult a
forall a.
Key ExpResult
-> Int
-> Maybe (ResultData a)
-> [ReplicationResult a]
-> ExperimentResult a
ExperimentResult Key ExpResult
kExpRes Int
nr Maybe (ResultData a)
forall a. Maybe a
Nothing [])
    truncateExperiments :: Int
-> [ExperimentResult a]
-> ReaderT SqlBackend (LoggingT (ResourceT m)) [ExperimentResult a]
truncateExperiments Int
nr [ExperimentResult a]
xs = do
      let dels :: [ExperimentResult a]
dels = (ExperimentResult a -> Bool)
-> [ExperimentResult a] -> [ExperimentResult a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
nr) (Int -> Bool)
-> (ExperimentResult a -> Int) -> ExperimentResult a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int (ExperimentResult a) Int -> ExperimentResult a -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (ExperimentResult a) Int
forall a. Lens' (ExperimentResult a) Int
repetitionNumber) [ExperimentResult a]
xs
      Bool
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ExperimentResult a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExperimentResult a]
dels) (ReaderT SqlBackend (LoggingT (ResourceT m)) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall a b. (a -> b) -> a -> b
$ Text
"Number of experiment repetitions being deleted " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([ExperimentResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ExperimentResult a]
dels)
      (ExperimentResult a
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> [ExperimentResult a]
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ExperimentResult a
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall (m :: * -> *) a. MonadIO m => ExperimentResult a -> DB m ()
deleteExperimentResult [ExperimentResult a]
dels
      Bool
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ExperimentResult a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ExperimentResult a]
dels) ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
      [ExperimentResult a]
-> ReaderT SqlBackend (LoggingT (ResourceT m)) [ExperimentResult a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ExperimentResult a]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT m)) [ExperimentResult a])
-> [ExperimentResult a]
-> ReaderT SqlBackend (LoggingT (ResourceT m)) [ExperimentResult a]
forall a b. (a -> b) -> a -> b
$ (ExperimentResult a -> Bool)
-> [ExperimentResult a] -> [ExperimentResult a]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
nr) (Int -> Bool)
-> (ExperimentResult a -> Int) -> ExperimentResult a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int (ExperimentResult a) Int -> ExperimentResult a -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (ExperimentResult a) Int
forall a. Lens' (ExperimentResult a) Int
repetitionNumber) [ExperimentResult a]
xs

printParamSetting :: (ExperimentDef a) => Experiments a -> ParameterSetting a -> DB (ExpM a) ()
printParamSetting :: Experiments a -> ParameterSetting a -> DB (ExpM a) ()
printParamSetting Experiments a
exps (ParameterSetting Text
n ConnectionString
bs Bool
skipPrep ExperimentDesign
expDes) =
  case (ParameterSetup a -> Bool)
-> [ParameterSetup a] -> Maybe (ParameterSetup a)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) (Text -> Bool)
-> (ParameterSetup a -> Text) -> ParameterSetup a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterSetup a -> Text
forall a. ParameterSetup a -> Text
parameterName) (Experiments a
exps Experiments a
-> Getting [ParameterSetup a] (Experiments a) [ParameterSetup a]
-> [ParameterSetup a]
forall s a. s -> Getting a s a -> a
^. Getting [ParameterSetup a] (Experiments a) [ParameterSetup a]
forall a. Lens' (Experiments a) [ParameterSetup a]
experimentsParameters) of
    (Just (ParameterSetup Text
_ b -> a -> a
setter a -> b
_ Maybe (b -> IO [b])
_ Maybe (b, b)
_ Maybe (b -> Bool)
_ Maybe (b -> ExperimentDesign)
_)) ->
      case Get b -> ConnectionString -> Either String b
forall a. Get a -> ConnectionString -> Either String a
S.runGet Get b
forall t. Serialize t => Get t
S.get ConnectionString
bs of
        Left String
_ -> DB (ExpM a) ()
err
        Right b
val -> do
          let a
_ = b -> a -> a
setter b
val (Experiments a
exps Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState) -- only needed for type inference
          $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> DB (ExpM a) ()) -> Text -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$
            Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> b -> Text
forall a. Show a => a -> Text
tshow b
val Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
            if Bool
skipPrep
              then Text
" [SkipPreparation] "
              else Text
"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                   if ExperimentDesign
expDes ExperimentDesign -> ExperimentDesign -> Bool
forall a. Eq a => a -> a -> Bool
== ExperimentDesign
SingleInstance
                     then Text
" [SingleInstance] "
                     else Text
""
    Maybe (ParameterSetup a)
_ -> DB (ExpM a) ()
err
  where
    err :: DB (ExpM a) ()
err = $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> DB (ExpM a) ()) -> Text -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ Text
n Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": Could not deserialise value as this parameter does not exist anymore. Thus keeping it unchanged."


data RepResultType
  = Prep !(Key ExpResult)
  | WarmUp !(Key RepResult)
  | Rep !(Key RepResult)


newResultData :: (ExperimentDef a) => Seed -> RepResultType -> a -> InputState a -> DB (ExpM a) (ResultData a)
newResultData :: Seed
-> RepResultType -> a -> InputState a -> DB (ExpM a) (ResultData a)
newResultData Seed
seed RepResultType
repResType a
st InputState a
inpSt = do
  UTCTime
time <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  ResultDataKey
k <-
    case RepResultType
repResType of
      Prep Key ExpResult
expResId -> do
        Serializable a
serSt <- LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Serializable a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Serializable a)
 -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a))
-> ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall a b. (a -> b) -> a -> b
$ a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable a
st
        Key PrepResultData
prepId <- PrepResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key PrepResultData)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (UTCTime
-> Maybe UTCTime
-> ConnectionString
-> Maybe ConnectionString
-> ConnectionString
-> Maybe ConnectionString
-> PrepResultData
PrepResultData UTCTime
time Maybe UTCTime
forall a. Maybe a
Nothing (Seed -> ConnectionString
serialiseSeed Seed
seed) Maybe ConnectionString
forall a. Maybe a
Nothing (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (InputState a)
forall t. Serialize t => Putter t
put InputState a
inpSt) Maybe ConnectionString
forall a. Maybe a
Nothing)
        StartStateType
-> ConnectionString
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *).
MonadIO m =>
StartStateType -> ConnectionString -> ReaderT SqlBackend m ()
setResDataStartState (Key PrepResultData -> StartStateType
StartStatePrep Key PrepResultData
prepId) (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (Serializable a)
forall t. Serialize t => Putter t
put Serializable a
serSt)
        Key ExpResult
-> [Update ExpResult]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key ExpResult
expResId [EntityField ExpResult (Maybe (Key PrepResultData))
forall typ.
(typ ~ Maybe (Key PrepResultData)) =>
EntityField ExpResult typ
ExpResultPrepResultData EntityField ExpResult (Maybe (Key PrepResultData))
-> Maybe (Key PrepResultData) -> Update ExpResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Key PrepResultData -> Maybe (Key PrepResultData)
forall a. a -> Maybe a
Just Key PrepResultData
prepId]
        ResultDataKey
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultDataKey
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey)
-> ResultDataKey
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey
forall a b. (a -> b) -> a -> b
$ Key PrepResultData -> ResultDataKey
ResultDataPrep Key PrepResultData
prepId
      WarmUp Key RepResult
repResId -> do
        Serializable a
serSt <- LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Serializable a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Serializable a)
 -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a))
-> ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall a b. (a -> b) -> a -> b
$ a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable a
st
        Key WarmUpResultData
wmUpId <- WarmUpResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key WarmUpResultData)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (UTCTime
-> Maybe UTCTime
-> ConnectionString
-> Maybe ConnectionString
-> ConnectionString
-> Maybe ConnectionString
-> WarmUpResultData
WarmUpResultData UTCTime
time Maybe UTCTime
forall a. Maybe a
Nothing (Seed -> ConnectionString
serialiseSeed Seed
seed) Maybe ConnectionString
forall a. Maybe a
Nothing (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (InputState a)
forall t. Serialize t => Putter t
put InputState a
inpSt) Maybe ConnectionString
forall a. Maybe a
Nothing)
        StartStateType
-> ConnectionString
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *).
MonadIO m =>
StartStateType -> ConnectionString -> ReaderT SqlBackend m ()
setResDataStartState (Key WarmUpResultData -> StartStateType
StartStateWarmUp Key WarmUpResultData
wmUpId) (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (Serializable a)
forall t. Serialize t => Putter t
put Serializable a
serSt)
        Key RepResult
-> [Update RepResult]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key RepResult
repResId [EntityField RepResult (Maybe (Key WarmUpResultData))
forall typ.
(typ ~ Maybe (Key WarmUpResultData)) =>
EntityField RepResult typ
RepResultWarmUpResultData EntityField RepResult (Maybe (Key WarmUpResultData))
-> Maybe (Key WarmUpResultData) -> Update RepResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Key WarmUpResultData -> Maybe (Key WarmUpResultData)
forall a. a -> Maybe a
Just Key WarmUpResultData
wmUpId]
        ResultDataKey
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultDataKey
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey)
-> ResultDataKey
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey
forall a b. (a -> b) -> a -> b
$ Key WarmUpResultData -> ResultDataKey
ResultDataWarmUp Key WarmUpResultData
wmUpId
      Rep Key RepResult
repResId -> do
        Serializable a
serSt <- LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Serializable a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Serializable a)
 -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall a b. (a -> b) -> a -> b
$ ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a))
-> ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall a b. (a -> b) -> a -> b
$ a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable a
st
        Key RepResultData
repResDataId <- RepResultData
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Key RepResultData)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (UTCTime
-> Maybe UTCTime
-> ConnectionString
-> Maybe ConnectionString
-> ConnectionString
-> Maybe ConnectionString
-> RepResultData
RepResultData UTCTime
time Maybe UTCTime
forall a. Maybe a
Nothing (Seed -> ConnectionString
serialiseSeed Seed
seed) Maybe ConnectionString
forall a. Maybe a
Nothing (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (InputState a)
forall t. Serialize t => Putter t
put InputState a
inpSt) Maybe ConnectionString
forall a. Maybe a
Nothing)
        StartStateType
-> ConnectionString
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *).
MonadIO m =>
StartStateType -> ConnectionString -> ReaderT SqlBackend m ()
setResDataStartState (Key RepResultData -> StartStateType
StartStateRep Key RepResultData
repResDataId) (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (Serializable a)
forall t. Serialize t => Putter t
put Serializable a
serSt)
        Key RepResult
-> [Update RepResult]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key RepResult
repResId [EntityField RepResult (Maybe (Key RepResultData))
forall typ.
(typ ~ Maybe (Key RepResultData)) =>
EntityField RepResult typ
RepResultRepResultData EntityField RepResult (Maybe (Key RepResultData))
-> Maybe (Key RepResultData) -> Update RepResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Key RepResultData -> Maybe (Key RepResultData)
forall a. a -> Maybe a
Just Key RepResultData
repResDataId]
        ResultDataKey
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultDataKey
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey)
-> ResultDataKey
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ResultDataKey
forall a b. (a -> b) -> a -> b
$ Key RepResultData -> ResultDataKey
ResultDataRep Key RepResultData
repResDataId
  let (a
fInp, b
fMeas) = (String -> a
forall a. HasCallStack => String -> a
error String
"called Conduit for input on unsaved result data", String -> b
forall a. HasCallStack => String -> a
error String
"called Conduit for measures on unsaved result data")
  Gen RealWorld
g <- IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Gen RealWorld)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld))
-> IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall a b. (a -> b) -> a -> b
$ Seed -> IO GenIO
forall (m :: * -> *). PrimMonad m => Seed -> m (Gen (PrimState m))
restore Seed
seed
  ResultData a -> DB (ExpM a) (ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultData a -> DB (ExpM a) (ResultData a))
-> ResultData a -> DB (ExpM a) (ResultData a)
forall a b. (a -> b) -> a -> b
$ ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
forall a.
ResultDataKey
-> UTCTime
-> Maybe UTCTime
-> GenIO
-> Maybe GenIO
-> AvailabilityList (ExpM a) (Input a)
-> AvailabilityList (ExpM a) Measure
-> Availability (ExpM a) a
-> Availability (ExpM a) (Maybe a)
-> InputState a
-> Maybe (InputState a)
-> ResultData a
ResultData ResultDataKey
k UTCTime
time Maybe UTCTime
forall a. Maybe a
Nothing Gen RealWorld
GenIO
g Maybe GenIO
forall a. Maybe a
Nothing ((Int, [Input a])
-> (AvailabilityListWhere
    -> ConduitT () (Input a) (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) (Input a)
forall (m :: * -> *) b.
(Int, [b])
-> (AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableList (Int
0, []) AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ()
forall a. a
fInp) ((Int, [Measure])
-> (AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) Measure
forall (m :: * -> *) b.
(Int, [b])
-> (AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableList (Int
0, []) AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ()
forall a. a
fMeas) (a -> Availability (ExpM a) a
forall (m :: * -> *) b. b -> Availability m b
Available a
st) (Maybe a -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. b -> Availability m b
Available Maybe a
forall a. Maybe a
Nothing) InputState a
inpSt Maybe (InputState a)
forall a. Maybe a
Nothing


runExperimentResult ::
     (ExperimentDef a)
  => SkipPreparation
  -> Rands
  -> Experiments a
  -> Key Exp
  -> ExperimentNumber
  -> ExperimentResult a
  -> DB (ExpM a) (Updated, ExperimentResult a)
runExperimentResult :: Bool
-> Rands
-> Experiments a
-> Key Exp
-> Int
-> ExperimentResult a
-> DB (ExpM a) (Bool, ExperimentResult a)
runExperimentResult Bool
skipPrep rands :: Rands
rands@([Seed]
prepRands, [Seed]
_, [Seed]
_) Experiments a
exps Key Exp
expId Int
expNr ExperimentResult a
expRes = do
  let repetNr :: Int
repetNr = ExperimentResult a
expRes ExperimentResult a -> Getting Int (ExperimentResult a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (ExperimentResult a) Int
forall a. Lens' (ExperimentResult a) Int
repetitionNumber
  let prepSeed :: Seed
prepSeed = [Seed]
prepRands [Seed] -> Int -> Seed
forall a. [a] -> Int -> a
!! (Int
repetNr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  (a
prepInitSt, Bool
delPrep) <-
    ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (a, Bool)
-> (Availability (ExpM a) (Maybe a)
    -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (a, Bool))
-> Maybe (Availability (ExpM a) (Maybe a))
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (a, Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((a, Bool)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (a, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
expInitSt, Bool
False)) ((Maybe a -> (a, Bool))
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (a, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, Bool) -> (a -> (a, Bool)) -> Maybe a -> (a, Bool)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a
expInitSt, Bool
True) (, Bool
False)) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (a, Bool))
-> (Availability (ExpM a) (Maybe a)
    -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a))
-> Availability (ExpM a) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (a, Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Availability (ExpM a) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable) (ExperimentResult a
expRes ExperimentResult a
-> Getting
     (First (Availability (ExpM a) (Maybe a)))
     (ExperimentResult a)
     (Availability (ExpM a) (Maybe a))
-> Maybe (Availability (ExpM a) (Maybe a))
forall s a. s -> Getting (First a) s a -> Maybe a
^? (Maybe (ResultData a)
 -> Const
      (First (Availability (ExpM a) (Maybe a))) (Maybe (ResultData a)))
-> ExperimentResult a
-> Const
     (First (Availability (ExpM a) (Maybe a))) (ExperimentResult a)
forall a. Lens' (ExperimentResult a) (Maybe (ResultData a))
preparationResults ((Maybe (ResultData a)
  -> Const
       (First (Availability (ExpM a) (Maybe a))) (Maybe (ResultData a)))
 -> ExperimentResult a
 -> Const
      (First (Availability (ExpM a) (Maybe a))) (ExperimentResult a))
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (First (Availability (ExpM a) (Maybe a)))
          (Availability (ExpM a) (Maybe a)))
    -> Maybe (ResultData a)
    -> Const
         (First (Availability (ExpM a) (Maybe a))) (Maybe (ResultData a)))
-> Getting
     (First (Availability (ExpM a) (Maybe a)))
     (ExperimentResult a)
     (Availability (ExpM a) (Maybe a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ResultData a
 -> Const (First (Availability (ExpM a) (Maybe a))) (ResultData a))
-> Maybe (ResultData a)
-> Const
     (First (Availability (ExpM a) (Maybe a))) (Maybe (ResultData a))
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
traversed ((ResultData a
  -> Const (First (Availability (ExpM a) (Maybe a))) (ResultData a))
 -> Maybe (ResultData a)
 -> Const
      (First (Availability (ExpM a) (Maybe a))) (Maybe (ResultData a)))
-> ((Availability (ExpM a) (Maybe a)
     -> Const
          (First (Availability (ExpM a) (Maybe a)))
          (Availability (ExpM a) (Maybe a)))
    -> ResultData a
    -> Const (First (Availability (ExpM a) (Maybe a))) (ResultData a))
-> (Availability (ExpM a) (Maybe a)
    -> Const
         (First (Availability (ExpM a) (Maybe a)))
         (Availability (ExpM a) (Maybe a)))
-> Maybe (ResultData a)
-> Const
     (First (Availability (ExpM a) (Maybe a))) (Maybe (ResultData a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Availability (ExpM a) (Maybe a)
 -> Const
      (First (Availability (ExpM a) (Maybe a)))
      (Availability (ExpM a) (Maybe a)))
-> ResultData a
-> Const (First (Availability (ExpM a) (Maybe a))) (ResultData a)
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState)
  (Bool
prepUpdated, Maybe (ResultData a)
prepRes) <-
    if Bool
skipPrep
      then do
        $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Skipping preparation phase as provided by the parameter setting (skipPreparationPhase)."
        (Bool, Maybe (ResultData a))
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Maybe (ResultData a)
forall a. Maybe a
Nothing)
      else Seed
-> Experiments a
-> Key Exp
-> Key ExpResult
-> CharPos
-> Bool
-> a
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, Maybe (ResultData a))
forall a.
ExperimentDef a =>
Seed
-> Experiments a
-> Key Exp
-> Key ExpResult
-> CharPos
-> Bool
-> a
-> Maybe (ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
runPreparation Seed
prepSeed Experiments a
exps Key Exp
expId Key ExpResult
expResId (Int
expNr, Int
repetNr) Bool
delPrep a
prepInitSt (ExperimentResult a
expRes ExperimentResult a
-> Getting
     (Maybe (ResultData a)) (ExperimentResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ExperimentResult a) (Maybe (ResultData a))
forall a. Lens' (ExperimentResult a) (Maybe (ResultData a))
preparationResults)
  [ReplicationResult a]
repsDone <-
    if Bool
prepUpdated
      then do
        (ReplicationResult a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [ReplicationResult a]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ReplicationResult a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => ReplicationResult a -> DB m ()
deleteReplicationResult (ExperimentResult a
expRes ExperimentResult a
-> Getting
     [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
-> [ReplicationResult a]
forall s a. s -> Getting a s a -> a
^. Getting
  [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults)
        [ReplicationResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ReplicationResult a]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      else [ReplicationResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ReplicationResult a]
forall (m :: * -> *) a. Monad m => a -> m a
return (ExperimentResult a
expRes ExperimentResult a
-> Getting
     [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
-> [ReplicationResult a]
forall s a. s -> Getting a s a -> a
^. Getting
  [ReplicationResult a] (ExperimentResult a) [ReplicationResult a]
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults)
  ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
  Maybe a
mEndSt <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
-> (ResultData a
    -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a))
-> Maybe (ResultData a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing) (Availability (ExpM a) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable (Availability (ExpM a) (Maybe a)
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a))
-> (ResultData a -> Availability (ExpM a) (Maybe a))
-> ResultData a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Availability (ExpM a) (Maybe a))
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
-> ResultData a -> Availability (ExpM a) (Maybe a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Availability (ExpM a) (Maybe a))
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState) Maybe (ResultData a)
prepRes
  let initSt :: a
initSt = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
expInitSt Maybe a
mEndSt
  let initInpSt :: InputState a
initInpSt = InputState a -> Maybe (InputState a) -> InputState a
forall a. a -> Maybe a -> a
fromMaybe (Experiments a
exps Experiments a
-> Getting (InputState a) (Experiments a) (InputState a)
-> InputState a
forall s a. s -> Getting a s a -> a
^. Getting (InputState a) (Experiments a) (InputState a)
forall a. Lens' (Experiments a) (InputState a)
experimentsInitialInputState) (Getting
  (Maybe (InputState a)) (ResultData a) (Maybe (InputState a))
-> ResultData a -> Maybe (InputState a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (InputState a)) (ResultData a) (Maybe (InputState a))
forall a. Lens' (ResultData a) (Maybe (InputState a))
endInputState (ResultData a -> Maybe (InputState a))
-> Maybe (ResultData a) -> Maybe (InputState a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (ResultData a)
prepRes)
  let runRepl :: Experiments a
-> ReplicationResult a
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, ReplicationResult a)
runRepl Experiments a
e ReplicationResult a
repRess = do
        (Bool, ReplicationResult a)
res <- Rands
-> Experiments a
-> Key Exp
-> CharPos
-> a
-> InputState a
-> ReplicationResult a
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, ReplicationResult a)
forall a.
ExperimentDef a =>
Rands
-> Experiments a
-> Key Exp
-> CharPos
-> a
-> InitialInputState a
-> ReplicationResult a
-> DB (ExpM a) (Bool, ReplicationResult a)
runReplicationResult Rands
rands Experiments a
e Key Exp
expId (Int
expNr, Int
repetNr) a
initSt InputState a
initInpSt ReplicationResult a
repRess
        ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
        (Bool, ReplicationResult a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, ReplicationResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool, ReplicationResult a)
res
  [(Bool, ReplicationResult a)]
repRes <- Experiments a
-> [ReplicationResult a]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [ReplicationResult a]
forall (m :: * -> *) a.
MonadIO m =>
Experiments a
-> [ReplicationResult a] -> DB m [ReplicationResult a]
getRepRes Experiments a
exps [ReplicationResult a]
repsDone ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) [ReplicationResult a]
-> ([ReplicationResult a]
    -> ReaderT
         SqlBackend
         (LoggingT (ResourceT (ExpM a)))
         [(Bool, ReplicationResult a)])
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [(Bool, ReplicationResult a)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ReplicationResult a
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Bool, ReplicationResult a))
-> [ReplicationResult a]
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     [(Bool, ReplicationResult a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Experiments a
-> ReplicationResult a
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, ReplicationResult a)
runRepl Experiments a
exps)
  let updated :: Bool
updated = ((Bool, ReplicationResult a) -> Bool)
-> [(Bool, ReplicationResult a)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool, ReplicationResult a) -> Bool
forall a b. (a, b) -> a
fst [(Bool, ReplicationResult a)]
repRes
      res :: [ReplicationResult a]
res = ((Bool, ReplicationResult a) -> ReplicationResult a)
-> [(Bool, ReplicationResult a)] -> [ReplicationResult a]
forall a b. (a -> b) -> [a] -> [b]
map (Bool, ReplicationResult a) -> ReplicationResult a
forall a b. (a, b) -> b
snd [(Bool, ReplicationResult a)]
repRes
  (Bool, ExperimentResult a)
-> DB (ExpM a) (Bool, ExperimentResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
prepUpdated Bool -> Bool -> Bool
|| Bool
updated, ASetter
  (ExperimentResult a)
  (ExperimentResult a)
  (Maybe (ResultData a))
  (Maybe (ResultData a))
-> Maybe (ResultData a) -> ExperimentResult a -> ExperimentResult a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ExperimentResult a)
  (ExperimentResult a)
  (Maybe (ResultData a))
  (Maybe (ResultData a))
forall a. Lens' (ExperimentResult a) (Maybe (ResultData a))
preparationResults Maybe (ResultData a)
prepRes (ExperimentResult a -> ExperimentResult a)
-> ExperimentResult a -> ExperimentResult a
forall a b. (a -> b) -> a -> b
$ ASetter
  (ExperimentResult a)
  (ExperimentResult a)
  [ReplicationResult a]
  [ReplicationResult a]
-> [ReplicationResult a]
-> ExperimentResult a
-> ExperimentResult a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ExperimentResult a)
  (ExperimentResult a)
  [ReplicationResult a]
  [ReplicationResult a]
forall a. Lens' (ExperimentResult a) [ReplicationResult a]
evaluationResults [ReplicationResult a]
res ExperimentResult a
expRes)
  where
    expInitSt :: a
expInitSt = Experiments a
exps Experiments a -> Getting a (Experiments a) a -> a
forall s a. s -> Getting a s a -> a
^. Getting a (Experiments a) a
forall a. Lens' (Experiments a) a
experimentsInitialState
    expResId :: Key ExpResult
expResId = ExperimentResult a
expRes ExperimentResult a
-> Getting (Key ExpResult) (ExperimentResult a) (Key ExpResult)
-> Key ExpResult
forall s a. s -> Getting a s a -> a
^. Getting (Key ExpResult) (ExperimentResult a) (Key ExpResult)
forall a. Lens' (ExperimentResult a) (Key ExpResult)
experimentResultKey
    getRepRes :: (MonadIO m) => Experiments a -> [ReplicationResult a] -> DB m [ReplicationResult a]
    getRepRes :: Experiments a
-> [ReplicationResult a] -> DB m [ReplicationResult a]
getRepRes Experiments a
exps' [ReplicationResult a]
repsDone = do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall a b. (a -> b) -> a -> b
$ Text
"Number of loaded replications: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([ReplicationResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReplicationResult a]
repsDone)
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT m)) ()
forall a b. (a -> b) -> a -> b
$ Text
"Number of new replications: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[ReplicationResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReplicationResult a]
repsDone Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Experiments a
exps Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationReplications])
      ([ReplicationResult a]
repsDone [ReplicationResult a]
-> [ReplicationResult a] -> [ReplicationResult a]
forall a. [a] -> [a] -> [a]
++) ([ReplicationResult a] -> [ReplicationResult a])
-> DB m [ReplicationResult a] -> DB m [ReplicationResult a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Int]
-> (Int
    -> ReaderT
         SqlBackend (LoggingT (ResourceT m)) (ReplicationResult a))
-> DB m [ReplicationResult a]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM
          [[ReplicationResult a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ReplicationResult a]
repsDone Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 .. Experiments a
exps' Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationReplications]
          (\Int
nr -> do
             Key RepResult
kRepRes <- RepResult
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key RepResult)
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
record -> ReaderT backend m (Key record)
insert (RepResult
 -> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key RepResult))
-> RepResult
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Key RepResult)
forall a b. (a -> b) -> a -> b
$ Key ExpResult
-> Int
-> Maybe (Key WarmUpResultData)
-> Maybe (Key RepResultData)
-> RepResult
RepResult (ExperimentResult a
expRes ExperimentResult a
-> Getting (Key ExpResult) (ExperimentResult a) (Key ExpResult)
-> Key ExpResult
forall s a. s -> Getting a s a -> a
^. Getting (Key ExpResult) (ExperimentResult a) (Key ExpResult)
forall a. Lens' (ExperimentResult a) (Key ExpResult)
experimentResultKey) Int
nr Maybe (Key WarmUpResultData)
forall a. Maybe a
Nothing Maybe (Key RepResultData)
forall a. Maybe a
Nothing
             ReplicationResult a
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) (ReplicationResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplicationResult a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT m)) (ReplicationResult a))
-> ReplicationResult a
-> ReaderT
     SqlBackend (LoggingT (ResourceT m)) (ReplicationResult a)
forall a b. (a -> b) -> a -> b
$ Key RepResult
-> Int
-> Maybe (ResultData a)
-> Maybe (ResultData a)
-> ReplicationResult a
forall a.
Key RepResult
-> Int
-> Maybe (ResultData a)
-> Maybe (ResultData a)
-> ReplicationResult a
ReplicationResult Key RepResult
kRepRes Int
nr Maybe (ResultData a)
forall a. Maybe a
Nothing Maybe (ResultData a)
forall a. Maybe a
Nothing)


runPreparation ::
     (ExperimentDef a)
  => Seed
  -> Experiments a
  -> Key Exp
  -> Key ExpResult
  -> (ExperimentNumber, RepetitionNumber)
  -> Bool
  -> a
  -> Maybe (ResultData a)
  -> DB (ExpM a) (Updated, Maybe (ResultData a))
runPreparation :: Seed
-> Experiments a
-> Key Exp
-> Key ExpResult
-> CharPos
-> Bool
-> a
-> Maybe (ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
runPreparation Seed
seed Experiments a
exps Key Exp
expId Key ExpResult
expResId (Int
expNr, Int
repetNr) Bool
prepDelNeeded a
prepInitSt Maybe (ResultData a)
mResData = do
  Gen RealWorld
g <- IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Gen RealWorld)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld))
-> IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall a b. (a -> b) -> a -> b
$ Seed -> IO GenIO
forall (m :: * -> *). PrimMonad m => Seed -> m (Gen (PrimState m))
restore Seed
seed
  a
initSt <- LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a)
-> ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall a b. (a -> b) -> a -> b
$ ExpM a a -> ResourceT (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a a -> ResourceT (ExpM a) a)
-> ExpM a a -> ResourceT (ExpM a) a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> GenIO -> a -> ExpM a a
forall a. ExperimentDef a => Int -> Int -> GenIO -> a -> ExpM a a
beforePreparationHook Int
expNr Int
repetNr Gen RealWorld
GenIO
g a
prepInitSt
  let len :: Int
len = Int -> (ResultData a -> Int) -> Maybe (ResultData a) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (AvailabilityList (ExpM a) Measure -> Int)
-> (ResultData a -> AvailabilityList (ExpM a) Measure)
-> ResultData a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
-> ResultData a -> AvailabilityList (ExpM a) Measure
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) Maybe (ResultData a)
mResData
  Maybe (ResultData a)
mResData' <-
    if Int -> Bool
delNeeded Int
len
      then RepResultType -> DB (ExpM a) ()
forall (m :: * -> *). MonadIO m => RepResultType -> DB m ()
deleteResultData (Key ExpResult -> RepResultType
Prep Key ExpResult
expResId) DB (ExpM a) ()
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
forall a. Maybe a
Nothing
      else Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
mResData
  Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int -> Bool
delNeeded Int
len) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> DB (ExpM a) ()) -> Text -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ Text
"Deletion of preparation data needed. Len: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
len
  Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
runNeeded Int
len) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Preparation run is needed"
  Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Int -> Bool
delNeeded Int
len) Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
runNeeded Int
len) Bool -> Bool -> Bool
&& Int
prepSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"preparation phase needs no change"
  if Int -> Bool
runNeeded Int
len
    then do
      (Bool, Maybe (ResultData a))
res <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
-> (ResultData a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a))
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
new a
initSt) ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
mResData' ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
-> (ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a)))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a))
run' Int
len
      IO () -> DB (ExpM a) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DB (ExpM a) ()) -> IO () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ a -> Int -> Int -> IO ()
forall a. ExperimentDef a => a -> Int -> Int -> IO ()
afterPreparationHook a
initSt Int
expNr Int
repetNr
      (Bool, Maybe (ResultData a))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool, Maybe (ResultData a))
res
    else (Bool, Maybe (ResultData a))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Bool
delNeeded Int
len Bool -> Bool -> Bool
|| Int -> Bool
runNeeded Int
len, Maybe (ResultData a)
mResData')
  where
    delNeeded :: Int -> Bool
delNeeded Int
len = Bool
prepDelNeeded Bool -> Bool -> Bool
|| Bool -> (ResultData a -> Bool) -> Maybe (ResultData a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\ResultData a
_ -> Int
prepSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len) Maybe (ResultData a)
mResData
    runNeeded :: Int -> Bool
runNeeded Int
len = Bool -> (ResultData a -> Bool) -> Maybe (ResultData a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
prepSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (\ResultData a
_ -> Int
prepSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len Bool -> Bool -> Bool
|| (Int -> Bool
delNeeded Int
len Bool -> Bool -> Bool
&& Int
prepSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)) Maybe (ResultData a)
mResData
    prepSteps :: Int
prepSteps = Experiments a
exps Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupPreparationSteps
    maxSteps :: Maybe Int
maxSteps = Experiments a
exps Experiments a
-> Getting (Maybe Int) (Experiments a) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const (Maybe Int) ExpsSetup)
-> Experiments a -> Const (Maybe Int) (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const (Maybe Int) ExpsSetup)
 -> Experiments a -> Const (Maybe Int) (Experiments a))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ExpsSetup -> Const (Maybe Int) ExpsSetup)
-> Getting (Maybe Int) (Experiments a) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ExpsSetup -> Const (Maybe Int) ExpsSetup
forall (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int)) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationMaxStepsBetweenSaves
    initInpSt :: InputState a
initInpSt = Experiments a
exps Experiments a
-> Getting (InputState a) (Experiments a) (InputState a)
-> InputState a
forall s a. s -> Getting a s a -> a
^. Getting (InputState a) (Experiments a) (InputState a)
forall a. Lens' (Experiments a) (InputState a)
experimentsInitialInputState
    new :: a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
new a
initSt = Seed
-> RepResultType
-> a
-> InputState a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall a.
ExperimentDef a =>
Seed
-> RepResultType -> a -> InputState a -> DB (ExpM a) (ResultData a)
newResultData Seed
seed (Key ExpResult -> RepResultType
Prep Key ExpResult
expResId) a
initSt InputState a
initInpSt
    run' :: Int -> ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a))
run' Int
len ResultData a
rD = ((Int -> Bool
delNeeded Int
len Bool -> Bool -> Bool
||) (Bool -> Bool)
-> (ResultData a -> Maybe (ResultData a))
-> (Bool, ResultData a)
-> (Bool, Maybe (ResultData a))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ResultData a -> Maybe (ResultData a)
forall a. a -> Maybe a
Just) ((Bool, ResultData a) -> (Bool, Maybe (ResultData a)))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, ResultData a)
forall a.
ExperimentDef a =>
Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, ResultData a)
runResultData Key Exp
expId Maybe Int
maxSteps Int
prepSteps (Key ExpResult -> RepResultType
Prep Key ExpResult
expResId) ResultData a
rD


runReplicationResult ::
     (ExperimentDef a)
  => Rands
  -> Experiments a
  -> Key Exp
  -> (ExperimentNumber, RepetitionNumber)
  -> InitialState a
  -> InitialInputState a
  -> ReplicationResult a
  -> DB (ExpM a) (Updated, ReplicationResult a)
runReplicationResult :: Rands
-> Experiments a
-> Key Exp
-> CharPos
-> a
-> InitialInputState a
-> ReplicationResult a
-> DB (ExpM a) (Bool, ReplicationResult a)
runReplicationResult ([Seed]
_, [Seed]
wmUpRands, [Seed]
replRands) Experiments a
exps Key Exp
expId (Int
expNr, Int
repetNr) a
initSt InitialInputState a
initInpSt ReplicationResult a
repRes = do
  let repliNr :: Int
repliNr = ReplicationResult a
repRes ReplicationResult a -> Getting Int (ReplicationResult a) Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int (ReplicationResult a) Int
forall a. Lens' (ReplicationResult a) Int
replicationNumber
  let randGenIdx :: Int
randGenIdx = (Int
repetNr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
replicats Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
repliNr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
  let wmUpRand :: Seed
wmUpRand = [Seed]
wmUpRands [Seed] -> Int -> Seed
forall a. [a] -> Int -> a
!! Int
randGenIdx
  let repRand :: Seed
repRand = [Seed]
replRands [Seed] -> Int -> Seed
forall a. [a] -> Int -> a
!! Int
randGenIdx
  $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Running replication " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
repliNr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" for experiment repetition " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
repetNr
  (Bool
wmUpChange, Maybe (ResultData a)
mWmUp) <- Seed
-> Experiments a
-> Key Exp
-> Key RepResult
-> (Int, Int, Int)
-> a
-> InitialInputState a
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, Maybe (ResultData a))
forall a.
ExperimentDef a =>
Seed
-> Experiments a
-> Key Exp
-> Key RepResult
-> (Int, Int, Int)
-> a
-> InitialInputState a
-> Maybe (ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
runWarmUp Seed
wmUpRand Experiments a
exps Key Exp
expId (ReplicationResult a
repRes ReplicationResult a
-> Getting (Key RepResult) (ReplicationResult a) (Key RepResult)
-> Key RepResult
forall s a. s -> Getting a s a -> a
^. Getting (Key RepResult) (ReplicationResult a) (Key RepResult)
forall a. Lens' (ReplicationResult a) (Key RepResult)
replicationResultKey) (Int
expNr, Int
repetNr, Int
repliNr) a
initSt InitialInputState a
initInpSt (ReplicationResult a
repRes ReplicationResult a
-> Getting
     (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
warmUpResults)
  a
initStEval <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> (ResultData a
    -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> Maybe (ResultData a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
initSt) ((Maybe a -> a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
initSt) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> (ResultData a
    -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a))
-> ResultData a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Availability (ExpM a) (Maybe a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable (Availability (ExpM a) (Maybe a)
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a))
-> (ResultData a -> Availability (ExpM a) (Maybe a))
-> ResultData a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Availability (ExpM a) (Maybe a))
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
-> ResultData a -> Availability (ExpM a) (Maybe a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Availability (ExpM a) (Maybe a))
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState) Maybe (ResultData a)
mWmUp
  let initInpStEval :: InitialInputState a
initInpStEval = InitialInputState a
-> Maybe (InitialInputState a) -> InitialInputState a
forall a. a -> Maybe a -> a
fromMaybe InitialInputState a
initInpSt (Getting
  (Maybe (InitialInputState a))
  (ResultData a)
  (Maybe (InitialInputState a))
-> ResultData a -> Maybe (InitialInputState a)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (InitialInputState a))
  (ResultData a)
  (Maybe (InitialInputState a))
forall a. Lens' (ResultData a) (Maybe (InputState a))
endInputState (ResultData a -> Maybe (InitialInputState a))
-> Maybe (ResultData a) -> Maybe (InitialInputState a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe (ResultData a)
mWmUp)
  Maybe (ResultData a)
mEval <-
    if Bool
wmUpChange
      then RepResultType
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => RepResultType -> DB m ()
deleteResultData (Key RepResult -> RepResultType
Rep Key RepResult
repResId) ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
forall a. Maybe a
Nothing
      else Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (ReplicationResult a
repRes ReplicationResult a
-> Getting
     (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
-> Maybe (ResultData a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (ResultData a)) (ReplicationResult a) (Maybe (ResultData a))
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults)
  (Bool
evalChange, Maybe (ResultData a)
mEval') <- Seed
-> Experiments a
-> Key Exp
-> Bool
-> Key RepResult
-> (Int, Int, Int)
-> a
-> InitialInputState a
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, Maybe (ResultData a))
forall a.
ExperimentDef a =>
Seed
-> Experiments a
-> Key Exp
-> Bool
-> Key RepResult
-> (Int, Int, Int)
-> a
-> InitialInputState a
-> Maybe (ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
runEval Seed
repRand Experiments a
exps Key Exp
expId Bool
wmUpChange (ReplicationResult a
repRes ReplicationResult a
-> Getting (Key RepResult) (ReplicationResult a) (Key RepResult)
-> Key RepResult
forall s a. s -> Getting a s a -> a
^. Getting (Key RepResult) (ReplicationResult a) (Key RepResult)
forall a. Lens' (ReplicationResult a) (Key RepResult)
replicationResultKey) (Int
expNr, Int
repetNr, Int
repliNr) a
initStEval InitialInputState a
initInpStEval Maybe (ResultData a)
mEval
  (Bool, ReplicationResult a)
-> DB (ExpM a) (Bool, ReplicationResult a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
wmUpChange Bool -> Bool -> Bool
|| Bool
evalChange, ASetter
  (ReplicationResult a)
  (ReplicationResult a)
  (Maybe (ResultData a))
  (Maybe (ResultData a))
-> Maybe (ResultData a)
-> ReplicationResult a
-> ReplicationResult a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ReplicationResult a)
  (ReplicationResult a)
  (Maybe (ResultData a))
  (Maybe (ResultData a))
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
warmUpResults Maybe (ResultData a)
mWmUp (ReplicationResult a -> ReplicationResult a)
-> ReplicationResult a -> ReplicationResult a
forall a b. (a -> b) -> a -> b
$ ASetter
  (ReplicationResult a)
  (ReplicationResult a)
  (Maybe (ResultData a))
  (Maybe (ResultData a))
-> Maybe (ResultData a)
-> ReplicationResult a
-> ReplicationResult a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ReplicationResult a)
  (ReplicationResult a)
  (Maybe (ResultData a))
  (Maybe (ResultData a))
forall a. Lens' (ReplicationResult a) (Maybe (ResultData a))
evalResults Maybe (ResultData a)
mEval' ReplicationResult a
repRes)
  where
    !repResId :: Key RepResult
repResId = ReplicationResult a
repRes ReplicationResult a
-> Getting (Key RepResult) (ReplicationResult a) (Key RepResult)
-> Key RepResult
forall s a. s -> Getting a s a -> a
^. Getting (Key RepResult) (ReplicationResult a) (Key RepResult)
forall a. Lens' (ReplicationResult a) (Key RepResult)
replicationResultKey
    !replicats :: Int
replicats = Experiments a
exps Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationReplications


runWarmUp ::
     (ExperimentDef a)
  => Seed
  -> Experiments a
  -> Key Exp
  -> Key RepResult
  -> (ExperimentNumber, RepetitionNumber, ReplicationNumber)
  -> InitialState a
  -> InitialInputState a
  -> Maybe (ResultData a)
  -> DB (ExpM a) (Updated, Maybe (ResultData a))
runWarmUp :: Seed
-> Experiments a
-> Key Exp
-> Key RepResult
-> (Int, Int, Int)
-> a
-> InitialInputState a
-> Maybe (ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
runWarmUp Seed
seed Experiments a
exps Key Exp
expId Key RepResult
repResId (Int
expNr, Int
repetNr, Int
repliNr) a
initSt InitialInputState a
initInpSt Maybe (ResultData a)
mResData = do
  !Gen RealWorld
g <- IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Gen RealWorld)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld))
-> IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall a b. (a -> b) -> a -> b
$ Seed -> IO GenIO
forall (m :: * -> *). PrimMonad m => Seed -> m (Gen (PrimState m))
restore Seed
seed
  !a
initStWmUp <- LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a)
-> ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall a b. (a -> b) -> a -> b
$ ExpM a a -> ResourceT (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a a -> ResourceT (ExpM a) a)
-> ExpM a a -> ResourceT (ExpM a) a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> GenIO -> a -> ExpM a a
forall a.
ExperimentDef a =>
Int -> Int -> Int -> GenIO -> a -> ExpM a a
beforeWarmUpHook Int
expNr Int
repetNr Int
repliNr Gen RealWorld
GenIO
g a
initSt
  let len :: Int
len = Int -> (ResultData a -> Int) -> Maybe (ResultData a) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (AvailabilityList (ExpM a) Measure -> Int)
-> (ResultData a -> AvailabilityList (ExpM a) Measure)
-> ResultData a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
-> ResultData a -> AvailabilityList (ExpM a) Measure
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) Maybe (ResultData a)
mResData
  Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int -> Bool
delNeeded Int
len) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Deletion of warm up data needed"
  Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
runNeeded Int
len) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Warm up run is needed"
  Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Int -> Bool
delNeeded Int
len) Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
runNeeded Int
len) Bool -> Bool -> Bool
&& Int
wmUpSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Warm up phase needs no change"
  !Maybe (ResultData a)
mResData' <-
    if Int -> Bool
delNeeded Int
len
      then RepResultType
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => RepResultType -> DB m ()
deleteResultData (Key RepResult -> RepResultType
WarmUp Key RepResult
repResId) ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
forall a. Maybe a
Nothing
      else Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
mResData
  if Int -> Bool
runNeeded Int
len
    then do
      !(Bool, Maybe (ResultData a))
res <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
-> (ResultData a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a))
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
new a
initStWmUp) ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
mResData' ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
-> (ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a)))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a))
run' Int
len
      IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ a -> Int -> Int -> Int -> IO ()
forall a. ExperimentDef a => a -> Int -> Int -> Int -> IO ()
afterWarmUpHook a
initSt Int
expNr Int
repetNr Int
repliNr
      (Bool, Maybe (ResultData a))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool, Maybe (ResultData a))
res
    else do
      Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
delNeeded Int
len) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Deleted warm up data."
      (Bool, Maybe (ResultData a))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Bool
delNeeded Int
len, Maybe (ResultData a)
mResData')
  where
    delNeeded :: Int -> Bool
delNeeded Int
len = Bool -> (ResultData a -> Bool) -> Maybe (ResultData a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\ResultData a
_ -> Int
wmUpSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len) Maybe (ResultData a)
mResData --  || maybe False ((>0) . lengthAvailabilityList) (mResData ^? traversed.results)
    runNeeded :: Int -> Bool
runNeeded Int
len = Bool -> (ResultData a -> Bool) -> Maybe (ResultData a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
wmUpSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (\ResultData a
_ -> Int
wmUpSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len Bool -> Bool -> Bool
|| (Int -> Bool
delNeeded Int
len Bool -> Bool -> Bool
&& Int
wmUpSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)) Maybe (ResultData a)
mResData
    !wmUpSteps :: Int
wmUpSteps = Experiments a
exps Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationWarmUpSteps
    !maxSteps :: Maybe Int
maxSteps = Experiments a
exps Experiments a
-> Getting (Maybe Int) (Experiments a) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const (Maybe Int) ExpsSetup)
-> Experiments a -> Const (Maybe Int) (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const (Maybe Int) ExpsSetup)
 -> Experiments a -> Const (Maybe Int) (Experiments a))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ExpsSetup -> Const (Maybe Int) ExpsSetup)
-> Getting (Maybe Int) (Experiments a) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ExpsSetup -> Const (Maybe Int) ExpsSetup
forall (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int)) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationMaxStepsBetweenSaves
    new :: a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
new !a
initStWmUp = Seed
-> RepResultType
-> a
-> InitialInputState a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall a.
ExperimentDef a =>
Seed
-> RepResultType -> a -> InputState a -> DB (ExpM a) (ResultData a)
newResultData Seed
seed (Key RepResult -> RepResultType
WarmUp Key RepResult
repResId) a
initStWmUp InitialInputState a
initInpSt
    run' :: Int -> ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a))
run' !Int
len !ResultData a
rD = ((Int -> Bool
delNeeded Int
len Bool -> Bool -> Bool
||) (Bool -> Bool)
-> (ResultData a -> Maybe (ResultData a))
-> (Bool, ResultData a)
-> (Bool, Maybe (ResultData a))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ResultData a -> Maybe (ResultData a)
forall a. a -> Maybe a
Just) ((Bool, ResultData a) -> (Bool, Maybe (ResultData a)))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, ResultData a)
forall a.
ExperimentDef a =>
Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, ResultData a)
runResultData Key Exp
expId Maybe Int
maxSteps Int
wmUpSteps (Key RepResult -> RepResultType
WarmUp Key RepResult
repResId) ResultData a
rD


runEval ::
     (ExperimentDef a)
  => Seed
  -> Experiments a
  -> Key Exp
  -> Updated
  -> Key RepResult
  -> (ExperimentNumber, RepetitionNumber, ReplicationNumber)
  -> InitialState a
  -> InitialInputState a
  -> Maybe (ResultData a)
  -> DB (ExpM a) (Updated, Maybe (ResultData a))
runEval :: Seed
-> Experiments a
-> Key Exp
-> Bool
-> Key RepResult
-> (Int, Int, Int)
-> a
-> InitialInputState a
-> Maybe (ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
runEval Seed
seed Experiments a
exps Key Exp
expId Bool
warmUpUpdated Key RepResult
repResId (Int
expNr, Int
repetNr, Int
repliNr) a
initSt InitialInputState a
initInpSt Maybe (ResultData a)
mResData = do
  !Gen RealWorld
g <- IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Gen RealWorld)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld))
-> IO (Gen RealWorld)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Gen RealWorld)
forall a b. (a -> b) -> a -> b
$ Seed -> IO GenIO
forall (m :: * -> *). PrimMonad m => Seed -> m (Gen (PrimState m))
restore Seed
seed
  !a
initStEval <- LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) a
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> LoggingT (ResourceT (ExpM a)) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a b. (a -> b) -> a -> b
$ ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a)
-> ResourceT (ExpM a) a -> LoggingT (ResourceT (ExpM a)) a
forall a b. (a -> b) -> a -> b
$ ExpM a a -> ResourceT (ExpM a) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a a -> ResourceT (ExpM a) a)
-> ExpM a a -> ResourceT (ExpM a) a
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int -> GenIO -> a -> ExpM a a
forall a.
ExperimentDef a =>
Int -> Int -> Int -> GenIO -> a -> ExpM a a
beforeEvaluationHook Int
expNr Int
repetNr Int
repliNr Gen RealWorld
GenIO
g a
initSt
  let len :: Int
len = Int -> (ResultData a -> Int) -> Maybe (ResultData a) -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (AvailabilityList (ExpM a) Measure -> Int)
-> (ResultData a -> AvailabilityList (ExpM a) Measure)
-> ResultData a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
-> ResultData a -> AvailabilityList (ExpM a) Measure
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) Maybe (ResultData a)
mResData
  !Maybe (ResultData a)
mResData' <-
    if Int -> Bool
delNeeded Int
len
      then RepResultType -> DB (ExpM a) ()
forall (m :: * -> *). MonadIO m => RepResultType -> DB m ()
deleteResultData (Key RepResult -> RepResultType
Rep Key RepResult
repResId) DB (ExpM a) ()
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
forall a. Maybe a
Nothing
      else Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
mResData
  Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int -> Bool
delNeeded Int
len) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Deletion of evaluation data needed"
  Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
runNeeded Int
len) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Evaluation run is needed"
  Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Int -> Bool
delNeeded Int
len) Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
runNeeded Int
len) Bool -> Bool -> Bool
&& Int
evalSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) Text
"Evaluation phase needs no change"
  if Int -> Bool
runNeeded Int
len
    then do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> DB (ExpM a) ()) -> Text -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ Text
"An evaluation run is needed for replication with ID " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (BackendKey SqlBackend -> Int64
unSqlBackendKey (BackendKey SqlBackend -> Int64) -> BackendKey SqlBackend -> Int64
forall a b. (a -> b) -> a -> b
$ Key RepResult -> BackendKey SqlBackend
unRepResultKey Key RepResult
repResId)
      !(Bool, Maybe (ResultData a))
res <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
-> (ResultData a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a))
-> Maybe (ResultData a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
new a
initStEval) ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (ResultData a)
mResData' ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
-> (ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a)))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a))
run' Int
len
      IO () -> DB (ExpM a) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> DB (ExpM a) ()) -> IO () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ a -> Int -> Int -> Int -> IO ()
forall a. ExperimentDef a => a -> Int -> Int -> Int -> IO ()
afterEvaluationHook a
initSt Int
expNr Int
repetNr Int
repliNr
      (Bool, Maybe (ResultData a))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool, Maybe (ResultData a))
res
    else do
      $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc -> Text -> LogLevel -> Text -> DB (ExpM a) ()
(Text -> DB (ExpM a) ())
-> (Text -> Text) -> Text -> DB (ExpM a) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> DB (ExpM a) ()) -> Text -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ Text
"No evaluation run needed for replication with ID " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
forall a. Show a => a -> Text
tshow (BackendKey SqlBackend -> Int64
unSqlBackendKey (BackendKey SqlBackend -> Int64) -> BackendKey SqlBackend -> Int64
forall a b. (a -> b) -> a -> b
$ Key RepResult -> BackendKey SqlBackend
unRepResultKey Key RepResult
repResId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". All needed data comes from the DB!"
      (Bool, Maybe (ResultData a))
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Bool
delNeeded Int
len, Maybe (ResultData a)
mResData')
  where
    delNeeded :: Int -> Bool
delNeeded Int
len = Bool
warmUpUpdated Bool -> Bool -> Bool
|| Bool -> (ResultData a -> Bool) -> Maybe (ResultData a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\ResultData a
_ -> Int
evalSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len) Maybe (ResultData a)
mResData
    runNeeded :: Int -> Bool
runNeeded Int
len = Bool -> (ResultData a -> Bool) -> Maybe (ResultData a) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int
evalSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (\ResultData a
_ -> Int
evalSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
len  Bool -> Bool -> Bool
|| (Int -> Bool
delNeeded Int
len Bool -> Bool -> Bool
&& Int
evalSteps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)) Maybe (ResultData a)
mResData
    !evalSteps :: Int
evalSteps = Experiments a
exps Experiments a -> Getting Int (Experiments a) Int -> Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const Int ExpsSetup)
-> Experiments a -> Const Int (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const Int ExpsSetup)
 -> Experiments a -> Const Int (Experiments a))
-> ((Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup)
-> Getting Int (Experiments a) Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> ExpsSetup -> Const Int ExpsSetup
forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationSteps
    !maxSteps :: Maybe Int
maxSteps = Experiments a
exps Experiments a
-> Getting (Maybe Int) (Experiments a) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. (ExpsSetup -> Const (Maybe Int) ExpsSetup)
-> Experiments a -> Const (Maybe Int) (Experiments a)
forall a. Lens' (Experiments a) ExpsSetup
experimentsSetup ((ExpsSetup -> Const (Maybe Int) ExpsSetup)
 -> Experiments a -> Const (Maybe Int) (Experiments a))
-> ((Maybe Int -> Const (Maybe Int) (Maybe Int))
    -> ExpsSetup -> Const (Maybe Int) ExpsSetup)
-> Getting (Maybe Int) (Experiments a) (Maybe Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int -> Const (Maybe Int) (Maybe Int))
-> ExpsSetup -> Const (Maybe Int) ExpsSetup
forall (f :: * -> *).
Functor f =>
(Maybe Int -> f (Maybe Int)) -> ExpsSetup -> f ExpsSetup
expsSetupEvaluationMaxStepsBetweenSaves
    new :: a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
new a
initStEval = Seed
-> RepResultType
-> a
-> InitialInputState a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall a.
ExperimentDef a =>
Seed
-> RepResultType -> a -> InputState a -> DB (ExpM a) (ResultData a)
newResultData Seed
seed (Key RepResult -> RepResultType
Rep Key RepResult
repResId) a
initStEval InitialInputState a
initInpSt
    run' :: Int -> ResultData a -> DB (ExpM a) (Bool, Maybe (ResultData a))
run' !Int
len !ResultData a
rD = ((Int -> Bool
delNeeded Int
len Bool -> Bool -> Bool
||) (Bool -> Bool)
-> (ResultData a -> Maybe (ResultData a))
-> (Bool, ResultData a)
-> (Bool, Maybe (ResultData a))
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ResultData a -> Maybe (ResultData a)
forall a. a -> Maybe a
Just) ((Bool, ResultData a) -> (Bool, Maybe (ResultData a)))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, ResultData a)
-> DB (ExpM a) (Bool, Maybe (ResultData a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Bool, ResultData a)
forall a.
ExperimentDef a =>
Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, ResultData a)
runResultData Key Exp
expId Maybe Int
maxSteps Int
evalSteps (Key RepResult -> RepResultType
Rep Key RepResult
repResId) ResultData a
rD


deleteReplicationResult :: (MonadIO m) => ReplicationResult a -> DB m ()
deleteReplicationResult :: ReplicationResult a -> DB m ()
deleteReplicationResult (ReplicationResult Key RepResult
repResId Int
_ Maybe (ResultData a)
_ Maybe (ResultData a)
_) =
  RepResultType -> DB m ()
forall (m :: * -> *). MonadIO m => RepResultType -> DB m ()
deleteResultData (Key RepResult -> RepResultType
WarmUp Key RepResult
repResId) DB m () -> DB m () -> DB m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  RepResultType -> DB m ()
forall (m :: * -> *). MonadIO m => RepResultType -> DB m ()
deleteResultData (Key RepResult -> RepResultType
Rep Key RepResult
repResId) DB m () -> DB m () -> DB m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Key RepResult -> DB m ()
forall record backend (m :: * -> *).
(DeleteCascade record backend, MonadIO m) =>
Key record -> ReaderT backend m ()
deleteCascade Key RepResult
repResId


deleteResultData :: (MonadIO m) => RepResultType -> DB m ()
deleteResultData :: RepResultType -> DB m ()
deleteResultData RepResultType
repResType = do
  case RepResultType
repResType of
    Prep Key ExpResult
expResId -> do
      Key ExpResult -> [Update ExpResult] -> DB m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key ExpResult
expResId [EntityField ExpResult (Maybe (Key PrepResultData))
forall typ.
(typ ~ Maybe (Key PrepResultData)) =>
EntityField ExpResult typ
ExpResultPrepResultData EntityField ExpResult (Maybe (Key PrepResultData))
-> Maybe (Key PrepResultData) -> Update ExpResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe (Key PrepResultData)
forall a. Maybe a
Nothing]
      Maybe ExpResult
exp <- Key ExpResult
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe ExpResult)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key ExpResult
expResId
      Maybe (DB m ()) -> DB m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (DB m ()) -> DB m ()) -> Maybe (DB m ()) -> DB m ()
forall a b. (a -> b) -> a -> b
$ Key PrepResultData -> DB m ()
forall record backend (m :: * -> *).
(DeleteCascade record backend, MonadIO m) =>
Key record -> ReaderT backend m ()
deleteCascade (Key PrepResultData -> DB m ())
-> Maybe (Key PrepResultData) -> Maybe (DB m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting
  (Maybe (Key PrepResultData)) ExpResult (Maybe (Key PrepResultData))
-> ExpResult -> Maybe (Key PrepResultData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (Key PrepResultData)) ExpResult (Maybe (Key PrepResultData))
forall (f :: * -> *).
Functor f =>
(Maybe (Key PrepResultData) -> f (Maybe (Key PrepResultData)))
-> ExpResult -> f ExpResult
expResultPrepResultData (ExpResult -> Maybe (Key PrepResultData))
-> Maybe ExpResult -> Maybe (Key PrepResultData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe ExpResult
exp)
    WarmUp Key RepResult
repResId -> do
      Key RepResult -> [Update RepResult] -> DB m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key RepResult
repResId [EntityField RepResult (Maybe (Key WarmUpResultData))
forall typ.
(typ ~ Maybe (Key WarmUpResultData)) =>
EntityField RepResult typ
RepResultWarmUpResultData EntityField RepResult (Maybe (Key WarmUpResultData))
-> Maybe (Key WarmUpResultData) -> Update RepResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe (Key WarmUpResultData)
forall a. Maybe a
Nothing]
      Maybe RepResult
repRes <- Key RepResult
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe RepResult)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key RepResult
repResId
      Maybe (DB m ()) -> DB m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (DB m ()) -> DB m ()) -> Maybe (DB m ()) -> DB m ()
forall a b. (a -> b) -> a -> b
$ Key WarmUpResultData -> DB m ()
forall record backend (m :: * -> *).
(DeleteCascade record backend, MonadIO m) =>
Key record -> ReaderT backend m ()
deleteCascade (Key WarmUpResultData -> DB m ())
-> Maybe (Key WarmUpResultData) -> Maybe (DB m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting
  (Maybe (Key WarmUpResultData))
  RepResult
  (Maybe (Key WarmUpResultData))
-> RepResult -> Maybe (Key WarmUpResultData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (Key WarmUpResultData))
  RepResult
  (Maybe (Key WarmUpResultData))
forall (f :: * -> *).
Functor f =>
(Maybe (Key WarmUpResultData) -> f (Maybe (Key WarmUpResultData)))
-> RepResult -> f RepResult
repResultWarmUpResultData (RepResult -> Maybe (Key WarmUpResultData))
-> Maybe RepResult -> Maybe (Key WarmUpResultData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RepResult
repRes)
    Rep Key RepResult
repResId -> do
      Key RepResult -> [Update RepResult] -> DB m ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update Key RepResult
repResId [EntityField RepResult (Maybe (Key RepResultData))
forall typ.
(typ ~ Maybe (Key RepResultData)) =>
EntityField RepResult typ
RepResultRepResultData EntityField RepResult (Maybe (Key RepResultData))
-> Maybe (Key RepResultData) -> Update RepResult
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe (Key RepResultData)
forall a. Maybe a
Nothing]
      Maybe RepResult
repRes <- Key RepResult
-> ReaderT SqlBackend (LoggingT (ResourceT m)) (Maybe RepResult)
forall backend record (m :: * -> *).
(PersistStoreRead backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> ReaderT backend m (Maybe record)
get Key RepResult
repResId
      Maybe (DB m ()) -> DB m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (Maybe (DB m ()) -> DB m ()) -> Maybe (DB m ()) -> DB m ()
forall a b. (a -> b) -> a -> b
$ Key RepResultData -> DB m ()
forall record backend (m :: * -> *).
(DeleteCascade record backend, MonadIO m) =>
Key record -> ReaderT backend m ()
deleteCascade (Key RepResultData -> DB m ())
-> Maybe (Key RepResultData) -> Maybe (DB m ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Getting
  (Maybe (Key RepResultData)) RepResult (Maybe (Key RepResultData))
-> RepResult -> Maybe (Key RepResultData)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Maybe (Key RepResultData)) RepResult (Maybe (Key RepResultData))
forall (f :: * -> *).
Functor f =>
(Maybe (Key RepResultData) -> f (Maybe (Key RepResultData)))
-> RepResult -> f RepResult
repResultRepResultData (RepResult -> Maybe (Key RepResultData))
-> Maybe RepResult -> Maybe (Key RepResultData)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe RepResult
repRes)

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


splitSizeMVar :: MVar Int
splitSizeMVar :: MVar Int
splitSizeMVar = IO (MVar Int) -> MVar Int
forall a. IO a -> a
unsafePerformIO (IO (MVar Int) -> MVar Int) -> IO (MVar Int) -> MVar Int
forall a b. (a -> b) -> a -> b
$ Int -> IO (MVar Int)
forall a. a -> IO (MVar a)
newMVar Int
2000
{-# NOINLINE splitSizeMVar #-}

increaseSplitSize :: IO ()
increaseSplitSize :: IO ()
increaseSplitSize = IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar Int -> (Int -> IO Int) -> IO Int
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Int
splitSizeMVar (Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> (Int -> Int) -> Int -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
128000 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
2))

decreaseSplitSize :: IO ()
decreaseSplitSize :: IO ()
decreaseSplitSize = IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int -> IO ()) -> IO Int -> IO ()
forall a b. (a -> b) -> a -> b
$ MVar Int -> (Int -> IO Int) -> IO Int
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Int
splitSizeMVar (Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> IO Int) -> (Int -> Int) -> Int -> IO Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
500 (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2))

getSplitSize :: IO Int
getSplitSize :: IO Int
getSplitSize = IO Int -> IO Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int -> IO Int) -> IO Int -> IO Int
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
5000 (Maybe Int -> Int) -> IO (Maybe Int) -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVar Int -> IO (Maybe Int)
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar Int
splitSizeMVar


data RunData a =
  RunData
  -- GenIO, a, InputState a, [Input a], [Measure])
    { RunData a -> GenIO
dataRandG    :: !GenIO
    , RunData a -> a
dataState    :: !a
    , RunData a -> InputState a
dataInpState :: !(InputState a)
    , RunData a -> Vector (Input a)
dataInputs   :: !(V.Vector (Input a))
    , RunData a -> Vector Measure
dataMeasures :: !(V.Vector Measure)
    } deriving ((forall x. RunData a -> Rep (RunData a) x)
-> (forall x. Rep (RunData a) x -> RunData a)
-> Generic (RunData a)
forall x. Rep (RunData a) x -> RunData a
forall x. RunData a -> Rep (RunData a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RunData a) x -> RunData a
forall a x. RunData a -> Rep (RunData a) x
$cto :: forall a x. Rep (RunData a) x -> RunData a
$cfrom :: forall a x. RunData a -> Rep (RunData a) x
Generic)

instance (ExperimentDef a) => NFData (RunData a) where
  rnf :: RunData a -> ()
rnf (RunData !GenIO
_ a
st InputState a
inpSt Vector (Input a)
inps Vector Measure
meas) = a -> ()
forall a. NFData a => a -> ()
rnf a
st () -> () -> ()
`seq` InputState a -> ()
forall a. NFData a => a -> ()
rnf InputState a
inpSt () -> () -> ()
`seq` Vector (Input a) -> ()
forall a. NFData a => a -> ()
rnf Vector (Input a)
inps () -> () -> ()
`seq` Vector Measure -> ()
forall a. NFData a => a -> ()
rnf Vector Measure
meas

-- | We need to sepearte @runResultData@ into two functions, as a simple recursive structure causes a space leak if it is not in IO. See
-- https://stackoverflow.com/questions/41306593/memory-leak-in-recursive-io-function-pap
-- https://ro-che.info/articles/2017-01-10-nested-loop-space-leak
-- https://gitlab.haskell.org/ghc/ghc/-/issues/13080
runResultData :: (ExperimentDef a) => Key Exp -> Maybe Int -> Int -> RepResultType -> ResultData a -> DB (ExpM a) (Updated, ResultData a)
runResultData :: Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, ResultData a)
runResultData !Key Exp
expId !Maybe Int
maxSteps !Int
len !RepResultType
repResType !ResultData a
resData = do
  (!Bool
done, !Bool
upd, !ResultData a
resData') <- Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (Bool, Bool, ResultData a)
forall a.
ExperimentDef a =>
Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, Bool, ResultData a)
runResultData' Key Exp
expId Maybe Int
maxSteps Int
len RepResultType
repResType ResultData a
resData
  if Bool
done
    then (Bool, ResultData a) -> DB (ExpM a) (Bool, ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
upd, ResultData a
resData')
    else Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, ResultData a)
forall a.
ExperimentDef a =>
Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, ResultData a)
runResultData Key Exp
expId Maybe Int
maxSteps Int
len RepResultType
repResType ResultData a
resData'
{-# NOINLINE runResultData #-}
{-# NOINLINE runResultData' #-}

-- | Wrapper due to GHC Bug. See @runResultData@.
runResultData' :: (ExperimentDef a) => Key Exp -> Maybe Int -> Int -> RepResultType -> ResultData a -> DB (ExpM a) (Bool, Updated, ResultData a)
runResultData' :: Key Exp
-> Maybe Int
-> Int
-> RepResultType
-> ResultData a
-> DB (ExpM a) (Bool, Bool, ResultData a)
runResultData' !Key Exp
expId !Maybe Int
maxSteps !Int
len !RepResultType
repResType !ResultData a
resData = do
  Availability (ExpM a) a
startStAvail <-
    (if Bool
isNew
       then Availability (ExpM a) a -> DB (ExpM a) (Availability (ExpM a) a)
forall (m :: * -> *) b.
Monad m =>
Availability m b -> DB m (Availability m b)
mkAvailable
       else Availability (ExpM a) a -> DB (ExpM a) (Availability (ExpM a) a)
forall (m :: * -> *) a. Monad m => a -> m a
return)
      (ResultData a
resData ResultData a
-> Getting
     (Availability (ExpM a) a) (ResultData a) (Availability (ExpM a) a)
-> Availability (ExpM a) a
forall s a. s -> Getting a s a -> a
^. Getting
  (Availability (ExpM a) a) (ResultData a) (Availability (ExpM a) a)
forall a. Lens' (ResultData a) (Availability (ExpM a) a)
startState)
  a
st <- Availability (ExpM a) (Maybe a) -> DB (ExpM a) (Maybe a)
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable (ResultData a
resData ResultData a
-> Getting
     (Availability (ExpM a) (Maybe a))
     (ResultData a)
     (Availability (ExpM a) (Maybe a))
-> Availability (ExpM a) (Maybe a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Availability (ExpM a) (Maybe a))
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState) DB (ExpM a) (Maybe a)
-> (Maybe a
    -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> (a -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a)
-> Maybe a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Availability (ExpM a) a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable Availability (ExpM a) a
startStAvail) a -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall (m :: * -> *) a. Monad m => a -> m a
return
  let stInp :: InputState a
stInp = InputState a -> Maybe (InputState a) -> InputState a
forall a. a -> Maybe a -> a
fromMaybe (ResultData a
resData ResultData a
-> Getting (InputState a) (ResultData a) (InputState a)
-> InputState a
forall s a. s -> Getting a s a -> a
^. Getting (InputState a) (ResultData a) (InputState a)
forall a. Lens' (ResultData a) (InputState a)
startInputState) (ResultData a
resData ResultData a
-> Getting
     (Maybe (InputState a)) (ResultData a) (Maybe (InputState a))
-> Maybe (InputState a)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (InputState a)) (ResultData a) (Maybe (InputState a))
forall a. Lens' (ResultData a) (Maybe (InputState a))
endInputState)
  let g :: Gen RealWorld
g = Gen RealWorld -> Maybe (Gen RealWorld) -> Gen RealWorld
forall a. a -> Maybe a -> a
fromMaybe (ResultData a
resData ResultData a
-> Getting (Gen RealWorld) (ResultData a) (Gen RealWorld)
-> Gen RealWorld
forall s a. s -> Getting a s a -> a
^. Getting (Gen RealWorld) (ResultData a) (Gen RealWorld)
forall a. Lens' (ResultData a) GenIO
startRandGen) (ResultData a
resData ResultData a
-> Getting
     (Maybe (Gen RealWorld)) (ResultData a) (Maybe (Gen RealWorld))
-> Maybe (Gen RealWorld)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (Gen RealWorld)) (ResultData a) (Maybe (Gen RealWorld))
forall a. Lens' (ResultData a) (Maybe GenIO)
endRandGen)
  Int
splitPeriods <- ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
-> (Int -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int)
-> Maybe Int
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (IO Int -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Int
getSplitSize) Int -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) Int
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
maxSteps
  let nrOfPeriodsToRun :: Int
nrOfPeriodsToRun = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
splitPeriods (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
curLen)
      periodsToRun :: [Int]
periodsToRun = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
curLen) [Int
1 .. Int
nrOfPeriodsToRun]
      printInfo :: Bool
printInfo = Int
splitPeriods Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
100 Bool -> Bool -> Bool
|| (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\Int
p -> (Int
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) [Int]
periodsToRun
  Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
printInfo (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Number of steps already run is " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
curLen Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", thus still need to run " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
curLen) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" steps."
  let updated :: Bool
updated = Bool -> Bool
not ([Int] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Int]
periodsToRun)
  UTCTime
sTime <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  let phase :: Phase
phase = ResultDataKey -> Phase
phaseFromResultDataKey (ResultData a
resData ResultData a
-> Getting ResultDataKey (ResultData a) ResultDataKey
-> ResultDataKey
forall s a. s -> Getting a s a -> a
^. Getting ResultDataKey (ResultData a) ResultDataKey
forall a. Lens' (ResultData a) ResultDataKey
resultDataKey)
      phaseNr :: Int
phaseNr = Phase -> Int
forall a. Enum a => a -> Int
fromEnum Phase
phase
  ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT
   SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Unique ExpProgress
-> ExpProgress
-> [Update ExpProgress]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
upsertBy (Key Exp -> Unique ExpProgress
UniqueExpProgress Key Exp
expId) (Key Exp -> Int -> Int -> ExpProgress
ExpProgress Key Exp
expId Int
phaseNr Int
curLen) [EntityField ExpProgress Int
forall typ. (typ ~ Int) => EntityField ExpProgress typ
ExpProgressPhase EntityField ExpProgress Int -> Int -> Update ExpProgress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Int
phaseNr, EntityField ExpProgress Int
forall typ. (typ ~ Int) => EntityField ExpProgress typ
ExpProgressStep EntityField ExpProgress Int -> Int -> Update ExpProgress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Int
curLen]
  !(RunData GenIO
g' a
st' InputState a
stInp' Vector (Input a)
inputs Vector Measure
measures) <- (RunData a
 -> Int
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (RunData a))
-> RunData a
-> [Int]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (RunData a)
forall a (m :: * -> *) b.
(NFData a, Monad m) =>
(a -> b -> m a) -> a -> [b] -> m a
foldM' (Phase
-> RunData a
-> Int
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) (RunData a)
forall a.
ExperimentDef a =>
Phase -> RunData a -> Int -> DB (ExpM a) (RunData a)
run Phase
phase) (GenIO
-> a
-> InputState a
-> Vector (Input a)
-> Vector Measure
-> RunData a
forall a.
GenIO
-> a
-> InputState a
-> Vector (Input a)
-> Vector Measure
-> RunData a
RunData Gen RealWorld
GenIO
g a
st InputState a
stInp Vector (Input a)
forall a. Vector a
V.empty Vector Measure
forall a. Vector a
V.empty) [Int]
periodsToRun
  Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ ReaderT
  SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT
   SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$
    Unique ExpProgress
-> ExpProgress
-> [Update ExpProgress]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Entity ExpProgress)
forall backend record (m :: * -> *).
(PersistUniqueWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Unique record
-> record -> [Update record] -> ReaderT backend m (Entity record)
upsertBy (Key Exp -> Unique ExpProgress
UniqueExpProgress Key Exp
expId) (Key Exp -> Int -> Int -> ExpProgress
ExpProgress Key Exp
expId Int
phaseNr (Int
curLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nrOfPeriodsToRun)) [EntityField ExpProgress Int
forall typ. (typ ~ Int) => EntityField ExpProgress typ
ExpProgressPhase EntityField ExpProgress Int -> Int -> Update ExpProgress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Int
phaseNr, EntityField ExpProgress Int
forall typ. (typ ~ Int) => EntityField ExpProgress typ
ExpProgressStep EntityField ExpProgress Int -> Int -> Update ExpProgress
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Int
curLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
nrOfPeriodsToRun]
  if Bool
updated
    then do
      Maybe UTCTime
eTime <- UTCTime -> Maybe UTCTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UTCTime -> Maybe UTCTime)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe UTCTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      UTCTime
sTime' <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      !ResultData a
resData' <-
        Vector (Input a)
-> Vector Measure
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
addInputValsAndMeasure (Vector (Input a) -> Vector (Input a)
forall a. Vector a -> Vector a
V.reverse Vector (Input a)
inputs) (Vector Measure -> Vector Measure
forall a. Vector a -> Vector a
V.reverse Vector Measure
measures) (ResultData a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a))
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall a b. (a -> b) -> a -> b
$ Bool
-> (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a. Bool -> (a -> a) -> a -> a
doIf Bool
isNew (ASetter (ResultData a) (ResultData a) UTCTime UTCTime
-> UTCTime -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter (ResultData a) (ResultData a) UTCTime UTCTime
forall a. Lens' (ResultData a) UTCTime
startTime UTCTime
sTime) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ ASetter
  (ResultData a)
  (ResultData a)
  (Maybe (InputState a))
  (Maybe (InputState a))
-> Maybe (InputState a) -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Maybe (InputState a))
  (Maybe (InputState a))
forall a. Lens' (ResultData a) (Maybe (InputState a))
endInputState (InputState a -> Maybe (InputState a)
forall a. a -> Maybe a
Just InputState a
stInp') (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
  (Availability (ExpM a) (Maybe a))
-> Availability (ExpM a) (Maybe a) -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
  (Availability (ExpM a) (Maybe a))
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState (Maybe a -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. b -> Availability m b
Available (Maybe a -> Availability (ExpM a) (Maybe a))
-> Maybe a -> Availability (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
st') (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$
        Bool
-> (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a. Bool -> (a -> a) -> a -> a
doIf Bool
isNew (ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) a)
  (Availability (ExpM a) a)
-> Availability (ExpM a) a -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) a)
  (Availability (ExpM a) a)
forall a. Lens' (ResultData a) (Availability (ExpM a) a)
startState Availability (ExpM a) a
startStAvail) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ -- make available once for saving
        ASetter
  (ResultData a)
  (ResultData a)
  (Maybe (Gen RealWorld))
  (Maybe (Gen RealWorld))
-> Maybe (Gen RealWorld) -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Maybe (Gen RealWorld))
  (Maybe (Gen RealWorld))
forall a. Lens' (ResultData a) (Maybe GenIO)
endRandGen (Gen RealWorld -> Maybe (Gen RealWorld)
forall a. a -> Maybe a
Just Gen RealWorld
GenIO
g') (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$
        ASetter
  (ResultData a) (ResultData a) (Maybe UTCTime) (Maybe UTCTime)
-> Maybe UTCTime -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a) (ResultData a) (Maybe UTCTime) (Maybe UTCTime)
forall a. Lens' (ResultData a) (Maybe UTCTime)
endTime Maybe UTCTime
eTime ResultData a
resData
      RepResultType
-> ResultData a
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a.
ExperimentDef a =>
RepResultType -> ResultData a -> DB (ExpM a) ()
upd RepResultType
repResType ResultData a
resData'
      ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *). MonadIO m => ReaderT SqlBackend m ()
transactionSave
      UTCTime
eTime' <- IO UTCTime
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
      let runTime :: NominalDiffTime
runTime = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime (Maybe UTCTime -> UTCTime
forall a. HasCallStack => Maybe a -> a
fromJust Maybe UTCTime
eTime) UTCTime
sTime
          saveTime :: NominalDiffTime
saveTime = UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
eTime' UTCTime
sTime'
      Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Int
maxSteps Bool -> Bool -> Bool
&& Int
nrOfPeriodsToRun Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
splitPeriods) (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> IO () -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NominalDiffTime
runTime NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
60 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
5 NominalDiffTime
saveTime) IO ()
increaseSplitSize
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (NominalDiffTime
runTime NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
> NominalDiffTime
120 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
* NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
5 NominalDiffTime
saveTime) IO ()
decreaseSplitSize
      Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
printInfo (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ $(Int
String
LogLevel
String -> Text
String -> String -> String -> CharPos -> CharPos -> Loc
Text -> Text
Loc
-> Text
-> LogLevel
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
(Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> (Text -> Text)
-> Text
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a. a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
pack :: String -> Text
monadLoggerLog :: forall (m :: * -> *) msg.
(MonadLogger m, ToLogStr msg) =>
Loc -> Text -> LogLevel -> msg -> m ()
id :: forall a. a -> a
. :: forall b c a. (b -> c) -> (a -> b) -> a -> c
logInfo) (Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> Text -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ Text
"Done and saved. Computation Time of " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow ([Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
periodsToRun) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall a. Show a => a -> Text
tshow NominalDiffTime
runTime Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Saving Time: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall a. Show a => a -> Text
tshow NominalDiffTime
saveTime
      if Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
curLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Int]
periodsToRun Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
        then (Bool, Bool, ResultData a)
-> DB (ExpM a) (Bool, Bool, ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Bool
True, ResultData a -> ResultData a
forall a. NFData a => a -> a
force ResultData a
resData') -- runResultData expId maxSteps len repResType (force resData')
        else (Bool, Bool, ResultData a)
-> DB (ExpM a) (Bool, Bool, ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Bool, Bool, ResultData a)
 -> DB (ExpM a) (Bool, Bool, ResultData a))
-> (Bool, Bool, ResultData a)
-> DB (ExpM a) (Bool, Bool, ResultData a)
forall a b. (a -> b) -> a -> b
$! (Bool
True, Bool
True, ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
  (Availability (ExpM a) (Maybe a))
-> Availability (ExpM a) (Maybe a) -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
  (Availability (ExpM a) (Maybe a))
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState Availability (ExpM a) (Maybe a)
mkEndStateAvailableOnDemand (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) a)
  (Availability (ExpM a) a)
-> Availability (ExpM a) a -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) a)
  (Availability (ExpM a) a)
forall a. Lens' (ResultData a) (Availability (ExpM a) a)
startState Availability (ExpM a) a
mkStartStateAvailableOnDemand ResultData a
resData')
    else (Bool, Bool, ResultData a)
-> DB (ExpM a) (Bool, Bool, ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Bool
False, ResultData a -> ResultData a
forall a. NFData a => a -> a
force (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
  (Availability (ExpM a) (Maybe a))
-> Availability (ExpM a) (Maybe a) -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) (Maybe a))
  (Availability (ExpM a) (Maybe a))
forall a. Lens' (ResultData a) (Availability (ExpM a) (Maybe a))
endState Availability (ExpM a) (Maybe a)
mkEndStateAvailableOnDemand (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) a)
  (Availability (ExpM a) a)
-> Availability (ExpM a) a -> ResultData a -> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (ResultData a)
  (ResultData a)
  (Availability (ExpM a) a)
  (Availability (ExpM a) a)
forall a. Lens' (ResultData a) (Availability (ExpM a) a)
startState Availability (ExpM a) a
mkStartStateAvailableOnDemand ResultData a
resData)
  where
    doIf :: Bool -> (a -> a) -> a -> a
doIf Bool
predicate ~a -> a
f
      | Bool
predicate = a -> a
f
      | Bool
otherwise = a -> a
forall a. a -> a
id
    curLen :: Int
curLen = AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (ResultData a
resData ResultData a
-> Getting
     (AvailabilityList (ExpM a) Measure)
     (ResultData a)
     (AvailabilityList (ExpM a) Measure)
-> AvailabilityList (ExpM a) Measure
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results)
    delInputs :: Bool
delInputs = AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (ResultData a
resData ResultData a
-> Getting
     (AvailabilityList (ExpM a) Measure)
     (ResultData a)
     (AvailabilityList (ExpM a) Measure)
-> AvailabilityList (ExpM a) Measure
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) Int -> Int -> Int
forall a. Num a => a -> a -> a
- AvailabilityList (ExpM a) (Input a) -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (ResultData a
resData ResultData a
-> Getting
     (AvailabilityList (ExpM a) (Input a))
     (ResultData a)
     (AvailabilityList (ExpM a) (Input a))
-> AvailabilityList (ExpM a) (Input a)
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) (Input a))
  (ResultData a)
  (AvailabilityList (ExpM a) (Input a))
forall a.
Lens' (ResultData a) (AvailabilityList (ExpM a) (Input a))
inputValues) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
    isNew :: Bool
isNew = Int
curLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
    mkStartStateAvailableOnDemand :: Availability (ExpM a) a
mkStartStateAvailableOnDemand =
      case ResultData a
resData ResultData a
-> Getting ResultDataKey (ResultData a) ResultDataKey
-> ResultDataKey
forall s a. s -> Getting a s a -> a
^. Getting ResultDataKey (ResultData a) ResultDataKey
forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep Key PrepResultData
key -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> Availability (ExpM a) a
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
 -> Availability (ExpM a) a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> Availability (ExpM a) a
forall a b. (a -> b) -> a -> b
$ Key Exp
-> StartStateType
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a.
ExperimentDef a =>
Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId (Key PrepResultData -> StartStateType
StartStatePrep Key PrepResultData
key)
        ResultDataWarmUp Key WarmUpResultData
key -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> Availability (ExpM a) a
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
 -> Availability (ExpM a) a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> Availability (ExpM a) a
forall a b. (a -> b) -> a -> b
$ Key Exp
-> StartStateType
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a.
ExperimentDef a =>
Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId (Key WarmUpResultData -> StartStateType
StartStateWarmUp Key WarmUpResultData
key)
        ResultDataRep Key RepResultData
key -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> Availability (ExpM a) a
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
 -> Availability (ExpM a) a)
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
-> Availability (ExpM a) a
forall a b. (a -> b) -> a -> b
$ Key Exp
-> StartStateType
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) a
forall a.
ExperimentDef a =>
Key Exp -> StartStateType -> DB (ExpM a) a
loadResDataStartState Key Exp
expId (Key RepResultData -> StartStateType
StartStateRep Key RepResultData
key)
    mkEndStateAvailableOnDemand :: Availability (ExpM a) (Maybe a)
mkEndStateAvailableOnDemand =
      case ResultData a
resData ResultData a
-> Getting ResultDataKey (ResultData a) ResultDataKey
-> ResultDataKey
forall s a. s -> Getting a s a -> a
^. Getting ResultDataKey (ResultData a) ResultDataKey
forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
        ResultDataPrep Key PrepResultData
key -> DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a))
-> DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId (Key PrepResultData -> EndStateType
EndStatePrep Key PrepResultData
key)
        ResultDataWarmUp Key WarmUpResultData
key -> DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a))
-> DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId (Key WarmUpResultData -> EndStateType
EndStateWarmUp Key WarmUpResultData
key)
        ResultDataRep Key RepResultData
key -> DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall (m :: * -> *) b. DB m b -> Availability m b
AvailableOnDemand (DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a))
-> DB (ExpM a) (Maybe a) -> Availability (ExpM a) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
forall a.
ExperimentDef a =>
Key Exp -> EndStateType -> DB (ExpM a) (Maybe a)
loadResDataEndState Key Exp
expId (Key RepResultData -> EndStateType
EndStateRep Key RepResultData
key)
    addInputValsAndMeasure :: Vector (Input a)
-> Vector Measure
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
addInputValsAndMeasure !Vector (Input a)
inputVals !Vector Measure
measures !ResultData a
resData' =
      let countResults' :: Int
countResults' = AvailabilityList (ExpM a) Measure -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (ResultData a
resData' ResultData a
-> Getting
     (AvailabilityList (ExpM a) Measure)
     (ResultData a)
     (AvailabilityList (ExpM a) Measure)
-> AvailabilityList (ExpM a) Measure
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) Measure)
  (ResultData a)
  (AvailabilityList (ExpM a) Measure)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector Measure -> Int
forall a. Vector a -> Int
V.length Vector Measure
measures
          countInputValues' :: Int
countInputValues' = AvailabilityList (ExpM a) (Input a) -> Int
forall (m :: * -> *) b. AvailabilityList m b -> Int
lengthAvailabilityList (ResultData a
resData' ResultData a
-> Getting
     (AvailabilityList (ExpM a) (Input a))
     (ResultData a)
     (AvailabilityList (ExpM a) (Input a))
-> AvailabilityList (ExpM a) (Input a)
forall s a. s -> Getting a s a -> a
^. Getting
  (AvailabilityList (ExpM a) (Input a))
  (ResultData a)
  (AvailabilityList (ExpM a) (Input a))
forall a.
Lens' (ResultData a) (AvailabilityList (ExpM a) (Input a))
inputValues) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Vector (Input a) -> Int
forall a. Vector a -> Int
V.length Vector (Input a)
inputVals
          measuresList :: [Measure]
measuresList = Vector Measure -> [Measure]
forall a. Vector a -> [a]
V.toList Vector Measure
measures
          inputValsList :: [Input a]
inputValsList = Vector (Input a) -> [Input a]
forall a. Vector a -> [a]
V.toList Vector (Input a)
inputVals
       in case ResultData a
resData' ResultData a
-> Getting ResultDataKey (ResultData a) ResultDataKey
-> ResultDataKey
forall s a. s -> Getting a s a -> a
^. Getting ResultDataKey (ResultData a) ResultDataKey
forall a. Lens' (ResultData a) ResultDataKey
resultDataKey of
            ResultDataPrep Key PrepResultData
key -> do
              Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delInputs (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ [Filter PrepInput]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall record backend (m :: * -> *).
(MonadIO m, DeleteCascade record backend,
 PersistQueryWrite backend) =>
[Filter record] -> ReaderT backend m ()
deleteCascadeWhere [EntityField PrepInput (Key PrepResultData)
forall typ. (typ ~ Key PrepResultData) => EntityField PrepInput typ
PrepInputPrepResultData EntityField PrepInput (Key PrepResultData)
-> Key PrepResultData -> Filter PrepInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key PrepResultData
key, EntityField PrepInput Int
forall typ. (typ ~ Int) => EntityField PrepInput typ
PrepInputPeriod EntityField PrepInput Int -> Int -> Filter PrepInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. Int
curLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]
              [Key PrepInput]
inpKeys <- [PrepInput]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepInput]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany ([PrepInput]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepInput])
-> [PrepInput]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepInput]
forall a b. (a -> b) -> a -> b
$ (Input a -> PrepInput) -> [Input a] -> [PrepInput]
forall a b. (a -> b) -> [a] -> [b]
map (Key PrepResultData -> Int -> PrepInput
PrepInput Key PrepResultData
key (Int -> PrepInput) -> (Input a -> Int) -> Input a -> PrepInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int (Input a) Int -> Input a -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (Input a) Int
forall a. Lens' (Input a) Int
inputValuePeriod) [Input a]
inputValsList
              [PrepInputValue]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([PrepInputValue]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [PrepInputValue]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ (Key PrepInput -> Input a -> PrepInputValue)
-> [Key PrepInput] -> [Input a] -> [PrepInputValue]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Key PrepInput
k Input a
v -> Key PrepInput -> ConnectionString -> PrepInputValue
PrepInputValue Key PrepInput
k (Put -> ConnectionString
runPut (Put -> ConnectionString)
-> (Input a -> Put) -> Input a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (InputValue a)
forall t. Serialize t => Putter t
put Putter (InputValue a)
-> (Input a -> InputValue a) -> Input a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (InputValue a) (Input a) (InputValue a)
-> Input a -> InputValue a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (InputValue a) (Input a) (InputValue a)
forall a a2.
Lens (Input a) (Input a2) (InputValue a) (InputValue a2)
inputValue (Input a -> ConnectionString) -> Input a -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Input a
v)) [Key PrepInput]
inpKeys [Input a]
inputValsList
              [Key PrepMeasure]
measureKeys <- [PrepMeasure]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepMeasure]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany ([PrepMeasure]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepMeasure])
-> ([Measure] -> [PrepMeasure])
-> [Measure]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepMeasure]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Measure -> PrepMeasure) -> [Measure] -> [PrepMeasure]
forall a b. (a -> b) -> [a] -> [b]
map (Key PrepResultData -> Int -> PrepMeasure
PrepMeasure Key PrepResultData
key (Int -> PrepMeasure) -> (Measure -> Int) -> Measure -> PrepMeasure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int Measure Int -> Measure -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Measure Int
Lens' Measure Int
measurePeriod) ([Measure]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepMeasure])
-> [Measure]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key PrepMeasure]
forall a b. (a -> b) -> a -> b
$ [Measure]
measuresList
              [PrepResultStep]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([PrepResultStep]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [PrepResultStep]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ [[PrepResultStep]] -> [PrepResultStep]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[PrepResultStep]] -> [PrepResultStep])
-> [[PrepResultStep]] -> [PrepResultStep]
forall a b. (a -> b) -> a -> b
$ (Key PrepMeasure -> Measure -> [PrepResultStep])
-> [Key PrepMeasure] -> [Measure] -> [[PrepResultStep]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Key PrepMeasure
k (Measure Int
_ [StepResult]
xs) -> (StepResult -> PrepResultStep) -> [StepResult] -> [PrepResultStep]
forall a b. (a -> b) -> [a] -> [b]
map (\(StepResult Text
n Maybe Double
mX Double
y) -> Key PrepMeasure -> Text -> Maybe Double -> Double -> PrepResultStep
PrepResultStep Key PrepMeasure
k Text
n Maybe Double
mX Double
y) [StepResult]
xs) [Key PrepMeasure]
measureKeys [Measure]
measuresList
              ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultData a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a))
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall a b. (a -> b) -> a -> b
$! (AvailabilityList (ExpM a) Measure
 -> Identity (AvailabilityList (ExpM a) Measure))
-> ResultData a -> Identity (ResultData a)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results ((AvailabilityList (ExpM a) Measure
  -> Identity (AvailabilityList (ExpM a) Measure))
 -> ResultData a -> Identity (ResultData a))
-> AvailabilityList (ExpM a) Measure
-> ResultData a
-> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int,
 AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) Measure
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
countResults', Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *).
MonadIO m =>
Key PrepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadPreparationMeasuresWhere Key PrepResultData
key) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ (AvailabilityList (ExpM a) (Input a)
 -> Identity (AvailabilityList (ExpM a) (Input a)))
-> ResultData a -> Identity (ResultData a)
forall a.
Lens' (ResultData a) (AvailabilityList (ExpM a) (Input a))
inputValues ((AvailabilityList (ExpM a) (Input a)
  -> Identity (AvailabilityList (ExpM a) (Input a)))
 -> ResultData a -> Identity (ResultData a))
-> AvailabilityList (ExpM a) (Input a)
-> ResultData a
-> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
.~
                (Int,
 AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) (Input a)
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
countInputValues', Key PrepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ()
forall (m :: * -> *) a.
(MonadIO m, ExperimentDef a) =>
Key PrepResultData
-> AvailabilityListWhere -> ConduitM () (Input a) (DB m) ()
loadPreparationInputWhere Key PrepResultData
key) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$
                ResultData a
resData'
            ResultDataWarmUp Key WarmUpResultData
key -> do
              Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delInputs (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ [Filter WarmUpInput]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall record backend (m :: * -> *).
(MonadIO m, DeleteCascade record backend,
 PersistQueryWrite backend) =>
[Filter record] -> ReaderT backend m ()
deleteCascadeWhere [EntityField WarmUpInput (Key WarmUpResultData)
forall typ.
(typ ~ Key WarmUpResultData) =>
EntityField WarmUpInput typ
WarmUpInputRepResult EntityField WarmUpInput (Key WarmUpResultData)
-> Key WarmUpResultData -> Filter WarmUpInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key WarmUpResultData
key, EntityField WarmUpInput Int
forall typ. (typ ~ Int) => EntityField WarmUpInput typ
WarmUpInputPeriod EntityField WarmUpInput Int -> Int -> Filter WarmUpInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. Int
curLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]
              [Key WarmUpInput]
inpKeys <- [WarmUpInput]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key WarmUpInput]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany ([WarmUpInput]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Key WarmUpInput])
-> [WarmUpInput]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key WarmUpInput]
forall a b. (a -> b) -> a -> b
$ (Input a -> WarmUpInput) -> [Input a] -> [WarmUpInput]
forall a b. (a -> b) -> [a] -> [b]
map (Key WarmUpResultData -> Int -> WarmUpInput
WarmUpInput Key WarmUpResultData
key (Int -> WarmUpInput) -> (Input a -> Int) -> Input a -> WarmUpInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int (Input a) Int -> Input a -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (Input a) Int
forall a. Lens' (Input a) Int
inputValuePeriod) [Input a]
inputValsList
              [WarmUpInputValue]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([WarmUpInputValue]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [WarmUpInputValue]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ (Key WarmUpInput -> Input a -> WarmUpInputValue)
-> [Key WarmUpInput] -> [Input a] -> [WarmUpInputValue]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Key WarmUpInput
k Input a
v -> Key WarmUpInput -> ConnectionString -> WarmUpInputValue
WarmUpInputValue Key WarmUpInput
k (Put -> ConnectionString
runPut (Put -> ConnectionString)
-> (Input a -> Put) -> Input a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (InputValue a)
forall t. Serialize t => Putter t
put Putter (InputValue a)
-> (Input a -> InputValue a) -> Input a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (InputValue a) (Input a) (InputValue a)
-> Input a -> InputValue a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (InputValue a) (Input a) (InputValue a)
forall a a2.
Lens (Input a) (Input a2) (InputValue a) (InputValue a2)
inputValue (Input a -> ConnectionString) -> Input a -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Input a
v)) [Key WarmUpInput]
inpKeys [Input a]
inputValsList
              [Key WarmUpMeasure]
measureKeys <- [WarmUpMeasure]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key WarmUpMeasure]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany ([WarmUpMeasure]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Key WarmUpMeasure])
-> [WarmUpMeasure]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key WarmUpMeasure]
forall a b. (a -> b) -> a -> b
$ (Measure -> WarmUpMeasure) -> [Measure] -> [WarmUpMeasure]
forall a b. (a -> b) -> [a] -> [b]
map (Key WarmUpResultData -> Int -> WarmUpMeasure
WarmUpMeasure Key WarmUpResultData
key (Int -> WarmUpMeasure)
-> (Measure -> Int) -> Measure -> WarmUpMeasure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int Measure Int -> Measure -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Measure Int
Lens' Measure Int
measurePeriod) [Measure]
measuresList
              [WarmUpResultStep]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([WarmUpResultStep]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [WarmUpResultStep]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ [[WarmUpResultStep]] -> [WarmUpResultStep]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[WarmUpResultStep]] -> [WarmUpResultStep])
-> [[WarmUpResultStep]] -> [WarmUpResultStep]
forall a b. (a -> b) -> a -> b
$ (Key WarmUpMeasure -> Measure -> [WarmUpResultStep])
-> [Key WarmUpMeasure] -> [Measure] -> [[WarmUpResultStep]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Key WarmUpMeasure
k (Measure Int
_ [StepResult]
xs) -> (StepResult -> WarmUpResultStep)
-> [StepResult] -> [WarmUpResultStep]
forall a b. (a -> b) -> [a] -> [b]
map (\(StepResult Text
n Maybe Double
mX Double
y) -> Key WarmUpMeasure
-> Text -> Maybe Double -> Double -> WarmUpResultStep
WarmUpResultStep Key WarmUpMeasure
k Text
n Maybe Double
mX Double
y) [StepResult]
xs) [Key WarmUpMeasure]
measureKeys [Measure]
measuresList
              ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultData a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a))
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall a b. (a -> b) -> a -> b
$! (AvailabilityList (ExpM a) Measure
 -> Identity (AvailabilityList (ExpM a) Measure))
-> ResultData a -> Identity (ResultData a)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results ((AvailabilityList (ExpM a) Measure
  -> Identity (AvailabilityList (ExpM a) Measure))
 -> ResultData a -> Identity (ResultData a))
-> AvailabilityList (ExpM a) Measure
-> ResultData a
-> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int,
 AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) Measure
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
countResults', Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *).
MonadIO m =>
Key WarmUpResultData
-> AvailabilityListWhere -> ConduitM () Measure (DB m) ()
loadReplicationWarmUpMeasuresWhere Key WarmUpResultData
key) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ (AvailabilityList (ExpM a) (Input a)
 -> Identity (AvailabilityList (ExpM a) (Input a)))
-> ResultData a -> Identity (ResultData a)
forall a.
Lens' (ResultData a) (AvailabilityList (ExpM a) (Input a))
inputValues ((AvailabilityList (ExpM a) (Input a)
  -> Identity (AvailabilityList (ExpM a) (Input a)))
 -> ResultData a -> Identity (ResultData a))
-> AvailabilityList (ExpM a) (Input a)
-> ResultData a
-> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
.~
                (Int,
 AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) (Input a)
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
countInputValues', Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ()
forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
Key WarmUpResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationWarmUpInputWhere Key WarmUpResultData
key) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$
                ResultData a
resData'
            ResultDataRep Key RepResultData
key -> do
              Bool
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
delInputs (ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ [Filter RepInput]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall record backend (m :: * -> *).
(MonadIO m, DeleteCascade record backend,
 PersistQueryWrite backend) =>
[Filter record] -> ReaderT backend m ()
deleteCascadeWhere [EntityField RepInput (Key RepResultData)
forall typ. (typ ~ Key RepResultData) => EntityField RepInput typ
RepInputRepResult EntityField RepInput (Key RepResultData)
-> Key RepResultData -> Filter RepInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
==. Key RepResultData
key, EntityField RepInput Int
forall typ. (typ ~ Int) => EntityField RepInput typ
RepInputPeriod EntityField RepInput Int -> Int -> Filter RepInput
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Filter v
>=. Int
curLen Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1]
              [Key RepInput]
inpKeys <- [RepInput]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key RepInput]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany ([RepInput]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Key RepInput])
-> [RepInput]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key RepInput]
forall a b. (a -> b) -> a -> b
$ (Input a -> RepInput) -> [Input a] -> [RepInput]
forall a b. (a -> b) -> [a] -> [b]
map (Key RepResultData -> Int -> RepInput
RepInput Key RepResultData
key (Int -> RepInput) -> (Input a -> Int) -> Input a -> RepInput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int (Input a) Int -> Input a -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int (Input a) Int
forall a. Lens' (Input a) Int
inputValuePeriod) [Input a]
inputValsList
              [RepInputValue]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([RepInputValue]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [RepInputValue]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ (Key RepInput -> Input a -> RepInputValue)
-> [Key RepInput] -> [Input a] -> [RepInputValue]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Key RepInput
k Input a
v -> Key RepInput -> ConnectionString -> RepInputValue
RepInputValue Key RepInput
k (Put -> ConnectionString
runPut (Put -> ConnectionString)
-> (Input a -> Put) -> Input a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (InputValue a)
forall t. Serialize t => Putter t
put Putter (InputValue a)
-> (Input a -> InputValue a) -> Input a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (InputValue a) (Input a) (InputValue a)
-> Input a -> InputValue a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (InputValue a) (Input a) (InputValue a)
forall a a2.
Lens (Input a) (Input a2) (InputValue a) (InputValue a2)
inputValue (Input a -> ConnectionString) -> Input a -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Input a
v)) [Key RepInput]
inpKeys [Input a]
inputValsList
              [Key RepMeasure]
measureKeys <- [RepMeasure]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key RepMeasure]
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m [Key record]
insertMany ([RepMeasure]
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) [Key RepMeasure])
-> [RepMeasure]
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) [Key RepMeasure]
forall a b. (a -> b) -> a -> b
$ (Measure -> RepMeasure) -> [Measure] -> [RepMeasure]
forall a b. (a -> b) -> [a] -> [b]
map (Key RepResultData -> Int -> RepMeasure
RepMeasure Key RepResultData
key (Int -> RepMeasure) -> (Measure -> Int) -> Measure -> RepMeasure
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting Int Measure Int -> Measure -> Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Measure Int
Lens' Measure Int
measurePeriod) [Measure]
measuresList
              [RepResultStep]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
[record] -> ReaderT backend m ()
insertMany_ ([RepResultStep]
 -> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ())
-> [RepResultStep]
-> ReaderT SqlBackend (LoggingT (ResourceT (ExpM a))) ()
forall a b. (a -> b) -> a -> b
$ [[RepResultStep]] -> [RepResultStep]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[RepResultStep]] -> [RepResultStep])
-> [[RepResultStep]] -> [RepResultStep]
forall a b. (a -> b) -> a -> b
$ (Key RepMeasure -> Measure -> [RepResultStep])
-> [Key RepMeasure] -> [Measure] -> [[RepResultStep]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Key RepMeasure
k (Measure Int
_ [StepResult]
xs) -> (StepResult -> RepResultStep) -> [StepResult] -> [RepResultStep]
forall a b. (a -> b) -> [a] -> [b]
map (\(StepResult Text
n Maybe Double
mX Double
y) -> Key RepMeasure -> Text -> Maybe Double -> Double -> RepResultStep
RepResultStep Key RepMeasure
k Text
n Maybe Double
mX Double
y) [StepResult]
xs) [Key RepMeasure]
measureKeys [Measure]
measuresList
              ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResultData a
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a))
-> ResultData a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (ResultData a)
forall a b. (a -> b) -> a -> b
$! (AvailabilityList (ExpM a) Measure
 -> Identity (AvailabilityList (ExpM a) Measure))
-> ResultData a -> Identity (ResultData a)
forall a. Lens' (ResultData a) (AvailabilityList (ExpM a) Measure)
results ((AvailabilityList (ExpM a) Measure
  -> Identity (AvailabilityList (ExpM a) Measure))
 -> ResultData a -> Identity (ResultData a))
-> AvailabilityList (ExpM a) Measure
-> ResultData a
-> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Int,
 AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) Measure
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
countResults', Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB (ExpM a)) ()
forall (m :: * -> *).
MonadIO m =>
Key RepResultData
-> AvailabilityListWhere -> ConduitT () Measure (DB m) ()
loadReplicationMeasuresWhere Key RepResultData
key) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$ (AvailabilityList (ExpM a) (Input a)
 -> Identity (AvailabilityList (ExpM a) (Input a)))
-> ResultData a -> Identity (ResultData a)
forall a.
Lens' (ResultData a) (AvailabilityList (ExpM a) (Input a))
inputValues ((AvailabilityList (ExpM a) (Input a)
  -> Identity (AvailabilityList (ExpM a) (Input a)))
 -> ResultData a -> Identity (ResultData a))
-> AvailabilityList (ExpM a) (Input a)
-> ResultData a
-> ResultData a
forall s t a b. ASetter s t a b -> b -> s -> t
.~
                (Int,
 AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ())
-> AvailabilityList (ExpM a) (Input a)
forall (m :: * -> *) b.
(Int, AvailabilityListWhere -> ConduitT () b (DB m) ())
-> AvailabilityList m b
AvailableListOnDemand (Int
countInputValues', Key RepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB (ExpM a)) ()
forall a (m :: * -> *).
(ExperimentDef a, MonadIO m) =>
Key RepResultData
-> AvailabilityListWhere -> ConduitT () (Input a) (DB m) ()
loadReplicationInputWhere Key RepResultData
key) (ResultData a -> ResultData a) -> ResultData a -> ResultData a
forall a b. (a -> b) -> a -> b
$
                ResultData a
resData'
    upd :: (ExperimentDef a) => RepResultType -> ResultData a -> DB (ExpM a) ()
    upd :: RepResultType -> ResultData a -> DB (ExpM a) ()
upd Prep{} (ResultData (ResultDataPrep Key PrepResultData
k) UTCTime
sTime Maybe UTCTime
eTime GenIO
sG Maybe GenIO
eG !AvailabilityList (ExpM a) (Input a)
_ !AvailabilityList (ExpM a) Measure
_ Availability (ExpM a) a
sSt Availability (ExpM a) (Maybe a)
eSt InputState a
sInpSt Maybe (InputState a)
eInpSt) = do
      !ConnectionString
sGBS <- IO ConnectionString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectionString
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString)
-> IO ConnectionString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString
forall a b. (a -> b) -> a -> b
$ GenIO -> IO ConnectionString
forall (m :: * -> *). MonadIO m => GenIO -> m ConnectionString
fromRandGen GenIO
sG
      !Maybe ConnectionString
eGBS <- IO (Maybe ConnectionString)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe ConnectionString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ConnectionString)
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe ConnectionString))
-> IO (Maybe ConnectionString)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe ConnectionString)
forall a b. (a -> b) -> a -> b
$ IO (Maybe ConnectionString)
-> (Gen RealWorld -> IO (Maybe ConnectionString))
-> Maybe (Gen RealWorld)
-> IO (Maybe ConnectionString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ConnectionString -> IO (Maybe ConnectionString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConnectionString
forall a. Maybe a
Nothing) ((ConnectionString -> Maybe ConnectionString)
-> IO ConnectionString -> IO (Maybe ConnectionString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionString -> Maybe ConnectionString
forall a. a -> Maybe a
Just (IO ConnectionString -> IO (Maybe ConnectionString))
-> (Gen RealWorld -> IO ConnectionString)
-> Gen RealWorld
-> IO (Maybe ConnectionString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen RealWorld -> IO ConnectionString
forall (m :: * -> *). MonadIO m => GenIO -> m ConnectionString
fromRandGen) Maybe (Gen RealWorld)
Maybe GenIO
eG
      Key PrepResultData -> [Update PrepResultData] -> DB (ExpM a) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update
        Key PrepResultData
k
        [ EntityField PrepResultData UTCTime
forall typ. (typ ~ UTCTime) => EntityField PrepResultData typ
PrepResultDataStartTime EntityField PrepResultData UTCTime
-> UTCTime -> Update PrepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. UTCTime
sTime
        , EntityField PrepResultData (Maybe UTCTime)
forall typ. (typ ~ Maybe UTCTime) => EntityField PrepResultData typ
PrepResultDataEndTime EntityField PrepResultData (Maybe UTCTime)
-> Maybe UTCTime -> Update PrepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe UTCTime
eTime
        , EntityField PrepResultData ConnectionString
forall typ.
(typ ~ ConnectionString) =>
EntityField PrepResultData typ
PrepResultDataStartRandGen EntityField PrepResultData ConnectionString
-> ConnectionString -> Update PrepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ConnectionString
sGBS
        , EntityField PrepResultData (Maybe ConnectionString)
forall typ.
(typ ~ Maybe ConnectionString) =>
EntityField PrepResultData typ
PrepResultDataEndRandGen EntityField PrepResultData (Maybe ConnectionString)
-> Maybe ConnectionString -> Update PrepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe ConnectionString
eGBS
        , EntityField PrepResultData ConnectionString
forall typ.
(typ ~ ConnectionString) =>
EntityField PrepResultData typ
PrepResultDataStartInputState EntityField PrepResultData ConnectionString
-> ConnectionString -> Update PrepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Put -> ConnectionString
runPut (Putter (InputState a)
forall t. Serialize t => Putter t
put InputState a
sInpSt)
        , EntityField PrepResultData (Maybe ConnectionString)
forall typ.
(typ ~ Maybe ConnectionString) =>
EntityField PrepResultData typ
PrepResultDataEndInputState EntityField PrepResultData (Maybe ConnectionString)
-> Maybe ConnectionString -> Update PrepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Put -> ConnectionString
runPut (Put -> ConnectionString)
-> Putter (InputState a) -> InputState a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (InputState a)
forall t. Serialize t => Putter t
put (InputState a -> ConnectionString)
-> Maybe (InputState a) -> Maybe ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
eInpSt
        ]
      Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
curLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ do
        ~Serializable a
serSt <- Availability (ExpM a) a -> DB (ExpM a) a
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable Availability (ExpM a) a
sSt DB (ExpM a) a
-> (a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Serializable a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> (a -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Serializable a)
 -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> (a -> ResourceT (ExpM a) (Serializable a))
-> a
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a))
-> (a -> ExpM a (Serializable a))
-> a
-> ResourceT (ExpM a) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable
        StartStateType -> ConnectionString -> DB (ExpM a) ()
forall (m :: * -> *).
MonadIO m =>
StartStateType -> ConnectionString -> ReaderT SqlBackend m ()
setResDataStartState (Key PrepResultData -> StartStateType
StartStatePrep Key PrepResultData
k) (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (Serializable a)
forall t. Serialize t => Putter t
put Serializable a
serSt)
      !Maybe (Serializable a)
serESt <- Availability (ExpM a) (Maybe a) -> DB (ExpM a) (Maybe a)
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable Availability (ExpM a) (Maybe a)
eSt DB (ExpM a) (Maybe a)
-> (Maybe a
    -> ReaderT
         SqlBackend
         (LoggingT (ResourceT (ExpM a)))
         (Maybe (Serializable a)))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Serializable a)))
-> (Maybe a
    -> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a)))
-> Maybe a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ExpM a) (Maybe (Serializable a))
-> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Maybe (Serializable a))
 -> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a)))
-> (Maybe a -> ResourceT (ExpM a) (Maybe (Serializable a)))
-> Maybe a
-> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpM a (Maybe (Serializable a))
-> ResourceT (ExpM a) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Maybe (Serializable a))
 -> ResourceT (ExpM a) (Maybe (Serializable a)))
-> (Maybe a -> ExpM a (Maybe (Serializable a)))
-> Maybe a
-> ResourceT (ExpM a) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ExpM a (Serializable a))
-> Maybe a -> ExpM a (Maybe (Serializable a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable
      EndStateType -> Maybe ConnectionString -> DB (ExpM a) ()
forall (m :: * -> *).
MonadIO m =>
EndStateType -> Maybe ConnectionString -> ReaderT SqlBackend m ()
setResDataEndState (Key PrepResultData -> EndStateType
EndStatePrep Key PrepResultData
k) (Put -> ConnectionString
runPut (Put -> ConnectionString)
-> Putter (Serializable a) -> Serializable a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (Serializable a)
forall t. Serialize t => Putter t
put (Serializable a -> ConnectionString)
-> Maybe (Serializable a) -> Maybe ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Serializable a)
serESt)
    upd WarmUp{} (ResultData (ResultDataWarmUp Key WarmUpResultData
k) UTCTime
sTime Maybe UTCTime
eTime GenIO
sG Maybe GenIO
eG !AvailabilityList (ExpM a) (Input a)
_ !AvailabilityList (ExpM a) Measure
_ Availability (ExpM a) a
sSt Availability (ExpM a) (Maybe a)
eSt InputState a
sInpSt Maybe (InputState a)
eInpSt) = do
      !ConnectionString
sGBS <- IO ConnectionString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectionString
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString)
-> IO ConnectionString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString
forall a b. (a -> b) -> a -> b
$ GenIO -> IO ConnectionString
forall (m :: * -> *). MonadIO m => GenIO -> m ConnectionString
fromRandGen GenIO
sG
      !Maybe ConnectionString
eGBS <- IO (Maybe ConnectionString)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe ConnectionString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ConnectionString)
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe ConnectionString))
-> IO (Maybe ConnectionString)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe ConnectionString)
forall a b. (a -> b) -> a -> b
$ IO (Maybe ConnectionString)
-> (Gen RealWorld -> IO (Maybe ConnectionString))
-> Maybe (Gen RealWorld)
-> IO (Maybe ConnectionString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ConnectionString -> IO (Maybe ConnectionString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConnectionString
forall a. Maybe a
Nothing) ((ConnectionString -> Maybe ConnectionString)
-> IO ConnectionString -> IO (Maybe ConnectionString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionString -> Maybe ConnectionString
forall a. a -> Maybe a
Just (IO ConnectionString -> IO (Maybe ConnectionString))
-> (Gen RealWorld -> IO ConnectionString)
-> Gen RealWorld
-> IO (Maybe ConnectionString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen RealWorld -> IO ConnectionString
forall (m :: * -> *). MonadIO m => GenIO -> m ConnectionString
fromRandGen) Maybe (Gen RealWorld)
Maybe GenIO
eG
      Key WarmUpResultData -> [Update WarmUpResultData] -> DB (ExpM a) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update
        Key WarmUpResultData
k
        [ EntityField WarmUpResultData UTCTime
forall typ. (typ ~ UTCTime) => EntityField WarmUpResultData typ
WarmUpResultDataStartTime EntityField WarmUpResultData UTCTime
-> UTCTime -> Update WarmUpResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. UTCTime
sTime
        , EntityField WarmUpResultData (Maybe UTCTime)
forall typ.
(typ ~ Maybe UTCTime) =>
EntityField WarmUpResultData typ
WarmUpResultDataEndTime EntityField WarmUpResultData (Maybe UTCTime)
-> Maybe UTCTime -> Update WarmUpResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe UTCTime
eTime
        , EntityField WarmUpResultData ConnectionString
forall typ.
(typ ~ ConnectionString) =>
EntityField WarmUpResultData typ
WarmUpResultDataStartRandGen EntityField WarmUpResultData ConnectionString
-> ConnectionString -> Update WarmUpResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ConnectionString
sGBS
        , EntityField WarmUpResultData (Maybe ConnectionString)
forall typ.
(typ ~ Maybe ConnectionString) =>
EntityField WarmUpResultData typ
WarmUpResultDataEndRandGen EntityField WarmUpResultData (Maybe ConnectionString)
-> Maybe ConnectionString -> Update WarmUpResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe ConnectionString
eGBS
        , EntityField WarmUpResultData ConnectionString
forall typ.
(typ ~ ConnectionString) =>
EntityField WarmUpResultData typ
WarmUpResultDataStartInputState EntityField WarmUpResultData ConnectionString
-> ConnectionString -> Update WarmUpResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Put -> ConnectionString
runPut (Putter (InputState a)
forall t. Serialize t => Putter t
put InputState a
sInpSt)
        , EntityField WarmUpResultData (Maybe ConnectionString)
forall typ.
(typ ~ Maybe ConnectionString) =>
EntityField WarmUpResultData typ
WarmUpResultDataEndInputState EntityField WarmUpResultData (Maybe ConnectionString)
-> Maybe ConnectionString -> Update WarmUpResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Put -> ConnectionString
runPut (Put -> ConnectionString)
-> Putter (InputState a) -> InputState a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (InputState a)
forall t. Serialize t => Putter t
put (InputState a -> ConnectionString)
-> Maybe (InputState a) -> Maybe ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
eInpSt
        ]
      Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
curLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ do
        ~Serializable a
serSt <- Availability (ExpM a) a -> DB (ExpM a) a
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable Availability (ExpM a) a
sSt DB (ExpM a) a
-> (a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Serializable a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> (a -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Serializable a)
 -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> (a -> ResourceT (ExpM a) (Serializable a))
-> a
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a))
-> (a -> ExpM a (Serializable a))
-> a
-> ResourceT (ExpM a) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable
        StartStateType -> ConnectionString -> DB (ExpM a) ()
forall (m :: * -> *).
MonadIO m =>
StartStateType -> ConnectionString -> ReaderT SqlBackend m ()
setResDataStartState (Key WarmUpResultData -> StartStateType
StartStateWarmUp Key WarmUpResultData
k) (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (Serializable a)
forall t. Serialize t => Putter t
put Serializable a
serSt)
      !Maybe (Serializable a)
serESt <- Availability (ExpM a) (Maybe a) -> DB (ExpM a) (Maybe a)
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable Availability (ExpM a) (Maybe a)
eSt DB (ExpM a) (Maybe a)
-> (Maybe a
    -> ReaderT
         SqlBackend
         (LoggingT (ResourceT (ExpM a)))
         (Maybe (Serializable a)))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Serializable a)))
-> (Maybe a
    -> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a)))
-> Maybe a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ExpM a) (Maybe (Serializable a))
-> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Maybe (Serializable a))
 -> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a)))
-> (Maybe a -> ResourceT (ExpM a) (Maybe (Serializable a)))
-> Maybe a
-> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpM a (Maybe (Serializable a))
-> ResourceT (ExpM a) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Maybe (Serializable a))
 -> ResourceT (ExpM a) (Maybe (Serializable a)))
-> (Maybe a -> ExpM a (Maybe (Serializable a)))
-> Maybe a
-> ResourceT (ExpM a) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ExpM a (Serializable a))
-> Maybe a -> ExpM a (Maybe (Serializable a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable
      EndStateType -> Maybe ConnectionString -> DB (ExpM a) ()
forall (m :: * -> *).
MonadIO m =>
EndStateType -> Maybe ConnectionString -> ReaderT SqlBackend m ()
setResDataEndState (Key WarmUpResultData -> EndStateType
EndStateWarmUp Key WarmUpResultData
k) (Put -> ConnectionString
runPut (Put -> ConnectionString)
-> Putter (Serializable a) -> Serializable a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (Serializable a)
forall t. Serialize t => Putter t
put (Serializable a -> ConnectionString)
-> Maybe (Serializable a) -> Maybe ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Serializable a)
serESt)
    upd Rep{} (ResultData (ResultDataRep Key RepResultData
k) UTCTime
sTime Maybe UTCTime
eTime GenIO
sG Maybe GenIO
eG !AvailabilityList (ExpM a) (Input a)
_ !AvailabilityList (ExpM a) Measure
_ Availability (ExpM a) a
sSt Availability (ExpM a) (Maybe a)
eSt InputState a
sInpSt Maybe (InputState a)
eInpSt) = do
      !ConnectionString
sGBS <- IO ConnectionString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ConnectionString
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString)
-> IO ConnectionString
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ConnectionString
forall a b. (a -> b) -> a -> b
$ GenIO -> IO ConnectionString
forall (m :: * -> *). MonadIO m => GenIO -> m ConnectionString
fromRandGen GenIO
sG
      !Maybe ConnectionString
eGBS <- IO (Maybe ConnectionString)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe ConnectionString)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ConnectionString)
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe ConnectionString))
-> IO (Maybe ConnectionString)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe ConnectionString)
forall a b. (a -> b) -> a -> b
$ IO (Maybe ConnectionString)
-> (Gen RealWorld -> IO (Maybe ConnectionString))
-> Maybe (Gen RealWorld)
-> IO (Maybe ConnectionString)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ConnectionString -> IO (Maybe ConnectionString)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConnectionString
forall a. Maybe a
Nothing) ((ConnectionString -> Maybe ConnectionString)
-> IO ConnectionString -> IO (Maybe ConnectionString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConnectionString -> Maybe ConnectionString
forall a. a -> Maybe a
Just (IO ConnectionString -> IO (Maybe ConnectionString))
-> (Gen RealWorld -> IO ConnectionString)
-> Gen RealWorld
-> IO (Maybe ConnectionString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Gen RealWorld -> IO ConnectionString
forall (m :: * -> *). MonadIO m => GenIO -> m ConnectionString
fromRandGen) Maybe (Gen RealWorld)
Maybe GenIO
eG
      Key RepResultData -> [Update RepResultData] -> DB (ExpM a) ()
forall backend record (m :: * -> *).
(PersistStoreWrite backend, MonadIO m,
 PersistRecordBackend record backend) =>
Key record -> [Update record] -> ReaderT backend m ()
update
        Key RepResultData
k
        [ EntityField RepResultData UTCTime
forall typ. (typ ~ UTCTime) => EntityField RepResultData typ
RepResultDataStartTime EntityField RepResultData UTCTime
-> UTCTime -> Update RepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. UTCTime
sTime
        , EntityField RepResultData (Maybe UTCTime)
forall typ. (typ ~ Maybe UTCTime) => EntityField RepResultData typ
RepResultDataEndTime EntityField RepResultData (Maybe UTCTime)
-> Maybe UTCTime -> Update RepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe UTCTime
eTime
        , EntityField RepResultData ConnectionString
forall typ.
(typ ~ ConnectionString) =>
EntityField RepResultData typ
RepResultDataStartRandGen EntityField RepResultData ConnectionString
-> ConnectionString -> Update RepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. ConnectionString
sGBS
        , EntityField RepResultData (Maybe ConnectionString)
forall typ.
(typ ~ Maybe ConnectionString) =>
EntityField RepResultData typ
RepResultDataEndRandGen EntityField RepResultData (Maybe ConnectionString)
-> Maybe ConnectionString -> Update RepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Maybe ConnectionString
eGBS
        , EntityField RepResultData ConnectionString
forall typ.
(typ ~ ConnectionString) =>
EntityField RepResultData typ
RepResultDataStartInputState EntityField RepResultData ConnectionString
-> ConnectionString -> Update RepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Put -> ConnectionString
runPut (Putter (InputState a)
forall t. Serialize t => Putter t
put InputState a
sInpSt)
        , EntityField RepResultData (Maybe ConnectionString)
forall typ.
(typ ~ Maybe ConnectionString) =>
EntityField RepResultData typ
RepResultDataEndInputState EntityField RepResultData (Maybe ConnectionString)
-> Maybe ConnectionString -> Update RepResultData
forall v typ.
PersistField typ =>
EntityField v typ -> typ -> Update v
=. Put -> ConnectionString
runPut (Put -> ConnectionString)
-> Putter (InputState a) -> InputState a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (InputState a)
forall t. Serialize t => Putter t
put (InputState a -> ConnectionString)
-> Maybe (InputState a) -> Maybe ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (InputState a)
eInpSt
        ]
      Bool -> DB (ExpM a) () -> DB (ExpM a) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
curLen Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (DB (ExpM a) () -> DB (ExpM a) ())
-> DB (ExpM a) () -> DB (ExpM a) ()
forall a b. (a -> b) -> a -> b
$ do
        ~Serializable a
serSt <- Availability (ExpM a) a -> DB (ExpM a) a
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable Availability (ExpM a) a
sSt DB (ExpM a) a
-> (a
    -> ReaderT
         SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggingT (ResourceT (ExpM a)) (Serializable a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Serializable a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a))
-> (a -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ExpM a) (Serializable a)
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Serializable a)
 -> LoggingT (ResourceT (ExpM a)) (Serializable a))
-> (a -> ResourceT (ExpM a) (Serializable a))
-> a
-> LoggingT (ResourceT (ExpM a)) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Serializable a) -> ResourceT (ExpM a) (Serializable a))
-> (a -> ExpM a (Serializable a))
-> a
-> ResourceT (ExpM a) (Serializable a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable
        StartStateType -> ConnectionString -> DB (ExpM a) ()
forall (m :: * -> *).
MonadIO m =>
StartStateType -> ConnectionString -> ReaderT SqlBackend m ()
setResDataStartState (Key RepResultData -> StartStateType
StartStateRep Key RepResultData
k) (Put -> ConnectionString
runPut (Put -> ConnectionString) -> Put -> ConnectionString
forall a b. (a -> b) -> a -> b
$ Putter (Serializable a)
forall t. Serialize t => Putter t
put Serializable a
serSt)
      !Maybe (Serializable a)
serESt <- Availability (ExpM a) (Maybe a) -> DB (ExpM a) (Maybe a)
forall (m :: * -> *) b. Monad m => Availability m b -> DB m b
mkTransientlyAvailable Availability (ExpM a) (Maybe a)
eSt DB (ExpM a) (Maybe a)
-> (Maybe a
    -> ReaderT
         SqlBackend
         (LoggingT (ResourceT (ExpM a)))
         (Maybe (Serializable a)))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (Maybe (Serializable a)))
-> (Maybe a
    -> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a)))
-> Maybe a
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResourceT (ExpM a) (Maybe (Serializable a))
-> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (Maybe (Serializable a))
 -> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a)))
-> (Maybe a -> ResourceT (ExpM a) (Maybe (Serializable a)))
-> Maybe a
-> LoggingT (ResourceT (ExpM a)) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExpM a (Maybe (Serializable a))
-> ResourceT (ExpM a) (Maybe (Serializable a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (Maybe (Serializable a))
 -> ResourceT (ExpM a) (Maybe (Serializable a)))
-> (Maybe a -> ExpM a (Maybe (Serializable a)))
-> Maybe a
-> ResourceT (ExpM a) (Maybe (Serializable a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> ExpM a (Serializable a))
-> Maybe a -> ExpM a (Maybe (Serializable a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> ExpM a (Serializable a)
forall a. ExperimentDef a => a -> ExpM a (Serializable a)
serialisable
      EndStateType -> Maybe ConnectionString -> DB (ExpM a) ()
forall (m :: * -> *).
MonadIO m =>
EndStateType -> Maybe ConnectionString -> ReaderT SqlBackend m ()
setResDataEndState (Key RepResultData -> EndStateType
EndStateRep Key RepResultData
k) (Put -> ConnectionString
runPut (Put -> ConnectionString)
-> Putter (Serializable a) -> Serializable a -> ConnectionString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Putter (Serializable a)
forall t. Serialize t => Putter t
put (Serializable a -> ConnectionString)
-> Maybe (Serializable a) -> Maybe ConnectionString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Serializable a)
serESt)
    upd RepResultType
_ ResultData a
_ = String -> DB (ExpM a) ()
forall a. HasCallStack => String -> a
error String
"Unexpected update combination. This is a bug, please report it!"


run :: (ExperimentDef a) => Phase -> RunData a -> Int -> DB (ExpM a) (RunData a)
run :: Phase -> RunData a -> Int -> DB (ExpM a) (RunData a)
run Phase
ph (RunData GenIO
g a
st InputState a
stInp Vector (Input a)
inpVals Vector Measure
res) Int
period = do
  -- let (randGen, g') = split g
  (!InputValue a
inpVal', !InputState a
inpSt') <- LoggingT (ResourceT (ExpM a)) (InputValue a, InputState a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (InputValue a, InputState a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) (InputValue a, InputState a)
 -> ReaderT
      SqlBackend
      (LoggingT (ResourceT (ExpM a)))
      (InputValue a, InputState a))
-> LoggingT (ResourceT (ExpM a)) (InputValue a, InputState a)
-> ReaderT
     SqlBackend
     (LoggingT (ResourceT (ExpM a)))
     (InputValue a, InputState a)
forall a b. (a -> b) -> a -> b
$! ResourceT (ExpM a) (InputValue a, InputState a)
-> LoggingT (ResourceT (ExpM a)) (InputValue a, InputState a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) (InputValue a, InputState a)
 -> LoggingT (ResourceT (ExpM a)) (InputValue a, InputState a))
-> ResourceT (ExpM a) (InputValue a, InputState a)
-> LoggingT (ResourceT (ExpM a)) (InputValue a, InputState a)
forall a b. (a -> b) -> a -> b
$! ExpM a (InputValue a, InputState a)
-> ResourceT (ExpM a) (InputValue a, InputState a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a (InputValue a, InputState a)
 -> ResourceT (ExpM a) (InputValue a, InputState a))
-> ExpM a (InputValue a, InputState a)
-> ResourceT (ExpM a) (InputValue a, InputState a)
forall a b. (a -> b) -> a -> b
$! GenIO
-> a -> InputState a -> Int -> ExpM a (InputValue a, InputState a)
forall a.
ExperimentDef a =>
GenIO
-> a -> InputState a -> Int -> ExpM a (InputValue a, InputState a)
generateInput GenIO
g a
st InputState a
stInp Int
period
  (![StepResult]
res', !a
st') <- LoggingT (ResourceT (ExpM a)) ([StepResult], a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ([StepResult], a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (LoggingT (ResourceT (ExpM a)) ([StepResult], a)
 -> ReaderT
      SqlBackend (LoggingT (ResourceT (ExpM a))) ([StepResult], a))
-> LoggingT (ResourceT (ExpM a)) ([StepResult], a)
-> ReaderT
     SqlBackend (LoggingT (ResourceT (ExpM a))) ([StepResult], a)
forall a b. (a -> b) -> a -> b
$! ResourceT (ExpM a) ([StepResult], a)
-> LoggingT (ResourceT (ExpM a)) ([StepResult], a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ResourceT (ExpM a) ([StepResult], a)
 -> LoggingT (ResourceT (ExpM a)) ([StepResult], a))
-> ResourceT (ExpM a) ([StepResult], a)
-> LoggingT (ResourceT (ExpM a)) ([StepResult], a)
forall a b. (a -> b) -> a -> b
$! ExpM a ([StepResult], a) -> ResourceT (ExpM a) ([StepResult], a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExpM a ([StepResult], a) -> ResourceT (ExpM a) ([StepResult], a))
-> ExpM a ([StepResult], a) -> ResourceT (ExpM a) ([StepResult], a)
forall a b. (a -> b) -> a -> b
$! Phase -> a -> InputValue a -> Int -> ExpM a ([StepResult], a)
forall a.
ExperimentDef a =>
Phase -> a -> InputValue a -> Int -> ExpM a ([StepResult], a)
runStep Phase
ph a
st InputValue a
inpVal' Int
period
  RunData a -> DB (ExpM a) (RunData a)
forall (m :: * -> *) a. Monad m => a -> m a
return (RunData a -> DB (ExpM a) (RunData a))
-> RunData a -> DB (ExpM a) (RunData a)
forall a b. (a -> b) -> a -> b
$! RunData a -> RunData a
forall a. NFData a => a -> a
force (RunData a -> RunData a) -> RunData a -> RunData a
forall a b. (a -> b) -> a -> b
$! GenIO
-> a
-> InputState a
-> Vector (Input a)
-> Vector Measure
-> RunData a
forall a.
GenIO
-> a
-> InputState a
-> Vector (Input a)
-> Vector Measure
-> RunData a
RunData GenIO
g a
st' InputState a
inpSt' (Int -> InputValue a -> Input a
forall a. Int -> InputValue a -> Input a
Input Int
period InputValue a
inpVal' Input a -> Vector (Input a) -> Vector (Input a)
forall a. a -> Vector a -> Vector a
`V.cons` Vector (Input a)
inpVals) (Int -> [StepResult] -> Measure
Measure Int
period [StepResult]
res' Measure -> Vector Measure -> Vector Measure
forall a. a -> Vector a -> Vector a
`V.cons` Vector Measure
res)