{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Scientist.Experiment
( Experiment
, newExperiment
, setExperimentTry
, setExperimentTryNamed
, setExperimentEnabled
, setExperimentOnException
, setExperimentCompare
, setExperimentContext
, setExperimentIgnore
, setExperimentRunIf
, setExperimentPublish
, experimentCompareEq
, experimentCompareOn
, experimentCompareBy
, experimentEnabledPercent
, getExperimentName
, getExperimentUse
, getExperimentTries
, getExperimentEnabled
, getExperimentOnException
, getExperimentCompare
, getExperimentContext
, getExperimentIgnore
, getExperimentRunIf
, getExperimentPublish
) where
import Prelude
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Random (evalRandIO, getRandomR)
import Data.Function (on)
import Data.List.NonEmpty
import Data.Maybe (fromMaybe)
import Data.Text (Text, pack)
import Scientist.Candidate
import Scientist.Control
import Scientist.NamedCandidate
import Scientist.Result
import UnliftIO.Exception (SomeException, throwIO)
data Experiment m c a b = Experiment
{ Experiment m c a b -> Text
experimentName :: Text
, Experiment m c a b -> m (Control a)
experimentUse :: m (Control a)
, Experiment m c a b -> Maybe (NonEmpty (NamedCandidate m b))
experimentTries :: Maybe (NonEmpty (NamedCandidate m b))
, Experiment m c a b -> Maybe (m Bool)
experimentEnabled :: Maybe (m Bool)
, Experiment m c a b -> Maybe (SomeException -> m ())
experimentOnException :: Maybe (SomeException -> m ())
, Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentCompare
:: Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
, Experiment m c a b -> Maybe c
experimentContext :: Maybe c
, Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentIgnore
:: Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
, Experiment m c a b -> Maybe Bool
experimentRunIf :: Maybe Bool
, Experiment m c a b -> Maybe (Result c a b -> m ())
experimentPublish :: Maybe (Result c a b -> m ())
, Experiment m c a b -> Int
experimentCandidateCount :: Int
}
newExperiment :: Functor m => Text -> m a -> Experiment m c a b
newExperiment :: Text -> m a -> Experiment m c a b
newExperiment Text
name m a
f = Experiment :: forall (m :: * -> *) c a b.
Text
-> m (Control a)
-> Maybe (NonEmpty (NamedCandidate m b))
-> Maybe (m Bool)
-> Maybe (SomeException -> m ())
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
-> Maybe c
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
-> Maybe Bool
-> Maybe (Result c a b -> m ())
-> Int
-> Experiment m c a b
Experiment
{ experimentName :: Text
experimentName = Text
name
, experimentUse :: m (Control a)
experimentUse = a -> Control a
forall a. a -> Control a
Control (a -> Control a) -> m a -> m (Control a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
f
, experimentTries :: Maybe (NonEmpty (NamedCandidate m b))
experimentTries = Maybe (NonEmpty (NamedCandidate m b))
forall a. Maybe a
Nothing
, experimentEnabled :: Maybe (m Bool)
experimentEnabled = Maybe (m Bool)
forall a. Maybe a
Nothing
, experimentOnException :: Maybe (SomeException -> m ())
experimentOnException = Maybe (SomeException -> m ())
forall a. Maybe a
Nothing
, experimentCompare :: Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentCompare = Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
forall a. Maybe a
Nothing
, experimentContext :: Maybe c
experimentContext = Maybe c
forall a. Maybe a
Nothing
, experimentIgnore :: Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentIgnore = Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
forall a. Maybe a
Nothing
, experimentRunIf :: Maybe Bool
experimentRunIf = Maybe Bool
forall a. Maybe a
Nothing
, experimentPublish :: Maybe (Result c a b -> m ())
experimentPublish = Maybe (Result c a b -> m ())
forall a. Maybe a
Nothing
, experimentCandidateCount :: Int
experimentCandidateCount = Int
0
}
setExperimentTry
:: Functor m => m b -> Experiment m c a b -> Experiment m c a b
setExperimentTry :: m b -> Experiment m c a b -> Experiment m c a b
setExperimentTry = Maybe Text -> m b -> Experiment m c a b -> Experiment m c a b
forall (m :: * -> *) b c a.
Functor m =>
Maybe Text -> m b -> Experiment m c a b -> Experiment m c a b
setExperimentTryInternal Maybe Text
forall a. Maybe a
Nothing
setExperimentTryNamed
:: Functor m => Text -> m b -> Experiment m c a b -> Experiment m c a b
setExperimentTryNamed :: Text -> m b -> Experiment m c a b -> Experiment m c a b
setExperimentTryNamed = Maybe Text -> m b -> Experiment m c a b -> Experiment m c a b
forall (m :: * -> *) b c a.
Functor m =>
Maybe Text -> m b -> Experiment m c a b -> Experiment m c a b
setExperimentTryInternal (Maybe Text -> m b -> Experiment m c a b -> Experiment m c a b)
-> (Text -> Maybe Text)
-> Text
-> m b
-> Experiment m c a b
-> Experiment m c a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Text
forall a. a -> Maybe a
Just
setExperimentTryInternal
:: Functor m => Maybe Text -> m b -> Experiment m c a b -> Experiment m c a b
setExperimentTryInternal :: Maybe Text -> m b -> Experiment m c a b -> Experiment m c a b
setExperimentTryInternal Maybe Text
mName m b
f Experiment m c a b
ex = Experiment m c a b
ex
{ experimentTries :: Maybe (NonEmpty (NamedCandidate m b))
experimentTries = NonEmpty (NamedCandidate m b)
-> Maybe (NonEmpty (NamedCandidate m b))
forall a. a -> Maybe a
Just NonEmpty (NamedCandidate m b)
updated
, experimentCandidateCount :: Int
experimentCandidateCount = Int
updatedCount
}
where
thisTry :: NonEmpty (NamedCandidate m b)
thisTry = NamedCandidate m b -> NonEmpty (NamedCandidate m b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedCandidate m b -> NonEmpty (NamedCandidate m b))
-> NamedCandidate m b -> NonEmpty (NamedCandidate m b)
forall a b. (a -> b) -> a -> b
$ Text -> m (Candidate b) -> NamedCandidate m b
forall (m :: * -> *) a.
Text -> m (Candidate a) -> NamedCandidate m a
namedCandidate Text
thisName (m (Candidate b) -> NamedCandidate m b)
-> m (Candidate b) -> NamedCandidate m b
forall a b. (a -> b) -> a -> b
$ b -> Candidate b
forall a. a -> Candidate a
Candidate (b -> Candidate b) -> m b -> m (Candidate b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m b
f
thisName :: Text
thisName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
inferName Maybe Text
mName
inferName :: Text
inferName = case Int
currentCount of
Int
0 -> Text
"candidate"
Int
n -> String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"candidate-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n
current :: Maybe (NonEmpty (NamedCandidate m b))
current = Experiment m c a b -> Maybe (NonEmpty (NamedCandidate m b))
forall (m :: * -> *) c a b.
Experiment m c a b -> Maybe (NonEmpty (NamedCandidate m b))
experimentTries Experiment m c a b
ex
updated :: NonEmpty (NamedCandidate m b)
updated = NonEmpty (NamedCandidate m b)
-> (NonEmpty (NamedCandidate m b) -> NonEmpty (NamedCandidate m b))
-> Maybe (NonEmpty (NamedCandidate m b))
-> NonEmpty (NamedCandidate m b)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NonEmpty (NamedCandidate m b)
thisTry (NonEmpty (NamedCandidate m b)
-> NonEmpty (NamedCandidate m b) -> NonEmpty (NamedCandidate m b)
forall a. Semigroup a => a -> a -> a
<> NonEmpty (NamedCandidate m b)
thisTry) Maybe (NonEmpty (NamedCandidate m b))
current
currentCount :: Int
currentCount = Experiment m c a b -> Int
forall (m :: * -> *) c a b. Experiment m c a b -> Int
experimentCandidateCount Experiment m c a b
ex
updatedCount :: Int
updatedCount = Int
currentCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
setExperimentEnabled :: m Bool -> Experiment m c a b -> Experiment m c a b
setExperimentEnabled :: m Bool -> Experiment m c a b -> Experiment m c a b
setExperimentEnabled m Bool
f Experiment m c a b
ex = Experiment m c a b
ex { experimentEnabled :: Maybe (m Bool)
experimentEnabled = m Bool -> Maybe (m Bool)
forall a. a -> Maybe a
Just m Bool
f }
setExperimentOnException
:: (SomeException -> m ()) -> Experiment m c a b -> Experiment m c a b
setExperimentOnException :: (SomeException -> m ()) -> Experiment m c a b -> Experiment m c a b
setExperimentOnException SomeException -> m ()
f Experiment m c a b
ex = Experiment m c a b
ex { experimentOnException :: Maybe (SomeException -> m ())
experimentOnException = (SomeException -> m ()) -> Maybe (SomeException -> m ())
forall a. a -> Maybe a
Just SomeException -> m ()
f }
setExperimentCompare
:: (Control a -> Either SomeException (Candidate b) -> Bool)
-> Experiment m c a b
-> Experiment m c a b
setExperimentCompare :: (Control a -> Either SomeException (Candidate b) -> Bool)
-> Experiment m c a b -> Experiment m c a b
setExperimentCompare Control a -> Either SomeException (Candidate b) -> Bool
f Experiment m c a b
ex = Experiment m c a b
ex { experimentCompare :: Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentCompare = (Control a -> Either SomeException (Candidate b) -> Bool)
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
forall a. a -> Maybe a
Just Control a -> Either SomeException (Candidate b) -> Bool
f }
setExperimentIgnore
:: (Control a -> Either SomeException (Candidate b) -> Bool)
-> Experiment m c a b
-> Experiment m c a b
setExperimentIgnore :: (Control a -> Either SomeException (Candidate b) -> Bool)
-> Experiment m c a b -> Experiment m c a b
setExperimentIgnore Control a -> Either SomeException (Candidate b) -> Bool
f Experiment m c a b
ex = Experiment m c a b
ex { experimentIgnore :: Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentIgnore = (Control a -> Either SomeException (Candidate b) -> Bool)
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
forall a. a -> Maybe a
Just Control a -> Either SomeException (Candidate b) -> Bool
f }
setExperimentRunIf :: Bool -> Experiment m c a b -> Experiment m c a b
setExperimentRunIf :: Bool -> Experiment m c a b -> Experiment m c a b
setExperimentRunIf Bool
b Experiment m c a b
ex = Experiment m c a b
ex { experimentRunIf :: Maybe Bool
experimentRunIf = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b }
setExperimentPublish
:: (Result c a b -> m ()) -> Experiment m c a b -> Experiment m c a b
setExperimentPublish :: (Result c a b -> m ()) -> Experiment m c a b -> Experiment m c a b
setExperimentPublish Result c a b -> m ()
f Experiment m c a b
ex = Experiment m c a b
ex { experimentPublish :: Maybe (Result c a b -> m ())
experimentPublish = (Result c a b -> m ()) -> Maybe (Result c a b -> m ())
forall a. a -> Maybe a
Just Result c a b -> m ()
f }
getExperimentName :: Experiment m c a b -> Text
getExperimentName :: Experiment m c a b -> Text
getExperimentName = Experiment m c a b -> Text
forall (m :: * -> *) c a b. Experiment m c a b -> Text
experimentName
getExperimentUse :: Experiment m c a b -> m (Control a)
getExperimentUse :: Experiment m c a b -> m (Control a)
getExperimentUse = Experiment m c a b -> m (Control a)
forall (m :: * -> *) c a b. Experiment m c a b -> m (Control a)
experimentUse
getExperimentTries
:: Experiment m c a b -> Maybe (NonEmpty (NamedCandidate m b))
getExperimentTries :: Experiment m c a b -> Maybe (NonEmpty (NamedCandidate m b))
getExperimentTries = Experiment m c a b -> Maybe (NonEmpty (NamedCandidate m b))
forall (m :: * -> *) c a b.
Experiment m c a b -> Maybe (NonEmpty (NamedCandidate m b))
experimentTries
getExperimentEnabled :: Applicative m => Experiment m c a b -> m Bool
getExperimentEnabled :: Experiment m c a b -> m Bool
getExperimentEnabled = m Bool -> Maybe (m Bool) -> m Bool
forall a. a -> Maybe a -> a
fromMaybe (Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) (Maybe (m Bool) -> m Bool)
-> (Experiment m c a b -> Maybe (m Bool))
-> Experiment m c a b
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Experiment m c a b -> Maybe (m Bool)
forall (m :: * -> *) c a b. Experiment m c a b -> Maybe (m Bool)
experimentEnabled
getExperimentOnException
:: MonadIO m => Experiment m c a b -> SomeException -> m ()
getExperimentOnException :: Experiment m c a b -> SomeException -> m ()
getExperimentOnException = (SomeException -> m ())
-> Maybe (SomeException -> m ()) -> SomeException -> m ()
forall a. a -> Maybe a -> a
fromMaybe SomeException -> m ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (Maybe (SomeException -> m ()) -> SomeException -> m ())
-> (Experiment m c a b -> Maybe (SomeException -> m ()))
-> Experiment m c a b
-> SomeException
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Experiment m c a b -> Maybe (SomeException -> m ())
forall (m :: * -> *) c a b.
Experiment m c a b -> Maybe (SomeException -> m ())
experimentOnException
getExperimentCompare
:: Experiment m c a b
-> (Control a -> Either SomeException (Candidate b) -> Bool)
getExperimentCompare :: Experiment m c a b
-> Control a -> Either SomeException (Candidate b) -> Bool
getExperimentCompare = (Control a -> Either SomeException (Candidate b) -> Bool)
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
-> Control a
-> Either SomeException (Candidate b)
-> Bool
forall a. a -> Maybe a -> a
fromMaybe (\Control a
_ Either SomeException (Candidate b)
_ -> Bool
False) (Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
-> Control a -> Either SomeException (Candidate b) -> Bool)
-> (Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool))
-> Experiment m c a b
-> Control a
-> Either SomeException (Candidate b)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
forall (m :: * -> *) c a b.
Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentCompare
setExperimentContext :: c -> Experiment m c a b -> Experiment m c a b
setExperimentContext :: c -> Experiment m c a b -> Experiment m c a b
setExperimentContext c
x Experiment m c a b
ex = Experiment m c a b
ex { experimentContext :: Maybe c
experimentContext = c -> Maybe c
forall a. a -> Maybe a
Just c
x }
getExperimentContext :: Experiment m c a b -> Maybe c
getExperimentContext :: Experiment m c a b -> Maybe c
getExperimentContext = Experiment m c a b -> Maybe c
forall (m :: * -> *) c a b. Experiment m c a b -> Maybe c
experimentContext
getExperimentIgnore
:: Experiment m c a b
-> (Control a -> Either SomeException (Candidate b) -> Bool)
getExperimentIgnore :: Experiment m c a b
-> Control a -> Either SomeException (Candidate b) -> Bool
getExperimentIgnore = (Control a -> Either SomeException (Candidate b) -> Bool)
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
-> Control a
-> Either SomeException (Candidate b)
-> Bool
forall a. a -> Maybe a -> a
fromMaybe (\Control a
_ Either SomeException (Candidate b)
_ -> Bool
False) (Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
-> Control a -> Either SomeException (Candidate b) -> Bool)
-> (Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool))
-> Experiment m c a b
-> Control a
-> Either SomeException (Candidate b)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
forall (m :: * -> *) c a b.
Experiment m c a b
-> Maybe (Control a -> Either SomeException (Candidate b) -> Bool)
experimentIgnore
getExperimentRunIf :: Experiment m c a b -> Bool
getExperimentRunIf :: Experiment m c a b -> Bool
getExperimentRunIf = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (Maybe Bool -> Bool)
-> (Experiment m c a b -> Maybe Bool) -> Experiment m c a b -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Experiment m c a b -> Maybe Bool
forall (m :: * -> *) c a b. Experiment m c a b -> Maybe Bool
experimentRunIf
getExperimentPublish
:: Applicative m => Experiment m c a b -> (Result c a b -> m ())
getExperimentPublish :: Experiment m c a b -> Result c a b -> m ()
getExperimentPublish = (Result c a b -> m ())
-> Maybe (Result c a b -> m ()) -> Result c a b -> m ()
forall a. a -> Maybe a -> a
fromMaybe (m () -> Result c a b -> m ()
forall a b. a -> b -> a
const (m () -> Result c a b -> m ()) -> m () -> Result c a b -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (Maybe (Result c a b -> m ()) -> Result c a b -> m ())
-> (Experiment m c a b -> Maybe (Result c a b -> m ()))
-> Experiment m c a b
-> Result c a b
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Experiment m c a b -> Maybe (Result c a b -> m ())
forall (m :: * -> *) c a b.
Experiment m c a b -> Maybe (Result c a b -> m ())
experimentPublish
experimentCompareEq
:: Eq a => Control a -> Either SomeException (Candidate a) -> Bool
experimentCompareEq :: Control a -> Either SomeException (Candidate a) -> Bool
experimentCompareEq = (a -> a -> Bool)
-> Control a -> Either SomeException (Candidate a) -> Bool
forall a b.
(a -> b -> Bool)
-> Control a -> Either SomeException (Candidate b) -> Bool
experimentCompareBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
experimentCompareOn
:: Eq b => (a -> b) -> Control a -> Either SomeException (Candidate a) -> Bool
experimentCompareOn :: (a -> b) -> Control a -> Either SomeException (Candidate a) -> Bool
experimentCompareOn a -> b
f = (a -> a -> Bool)
-> Control a -> Either SomeException (Candidate a) -> Bool
forall a b.
(a -> b -> Bool)
-> Control a -> Either SomeException (Candidate b) -> Bool
experimentCompareBy (b -> b -> Bool
forall a. Eq a => a -> a -> Bool
(==) (b -> b -> Bool) -> (a -> b) -> a -> a -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> b
f)
experimentCompareBy
:: (a -> b -> Bool) -> Control a -> Either SomeException (Candidate b) -> Bool
experimentCompareBy :: (a -> b -> Bool)
-> Control a -> Either SomeException (Candidate b) -> Bool
experimentCompareBy a -> b -> Bool
f (Control a
a) = \case
Left SomeException
_ -> Bool
False
Right (Candidate b
b) -> a -> b -> Bool
f a
a b
b
experimentEnabledPercent :: MonadIO m => Int -> m Bool
experimentEnabledPercent :: Int -> m Bool
experimentEnabledPercent Int
n
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
100 = Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
| Bool
otherwise = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Rand StdGen Bool -> IO Bool
forall a. Rand StdGen a -> IO a
evalRandIO (Rand StdGen Bool -> IO Bool) -> Rand StdGen Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n) (Int -> Bool) -> RandT StdGen Identity Int -> Rand StdGen Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> RandT StdGen Identity Int
forall (m :: * -> *) a. (MonadRandom m, Random a) => (a, a) -> m a
getRandomR (Int
0, Int
100)