{-# LANGUAGE RecursiveDo, MultiParamTypeClasses, TypeSynonymInstances, FlexibleInstances, RankNTypes #-}

-- |
-- Module     : Simulation.Aivika.Trans.Internal.Parameter
-- Copyright  : Copyright (c) 2009-2017, David Sorokin <david.sorokin@gmail.com>
-- License    : BSD3
-- Maintainer : David Sorokin <david.sorokin@gmail.com>
-- Stability  : experimental
-- Tested with: GHC 8.0.1
--
-- The module defines the 'Parameter' monad transformer that allows representing the model
-- parameters. For example, they can be used when running the Monte-Carlo simulation.
-- 
-- In general, this monad is very useful for representing a computation which is external
-- relative to the model itself.
--
module Simulation.Aivika.Trans.Internal.Parameter
       (-- * Parameter
        Parameter(..),
        ParameterLift(..),
        invokeParameter,
        runParameter,
        runParameters,
        -- * Error Handling
        catchParameter,
        finallyParameter,
        throwParameter,
        -- * Predefined Parameters
        simulationIndex,
        simulationCount,
        simulationSpecs,
        simulationEventQueue,
        starttime,
        stoptime,
        dt,
        generatorParameter,
        -- * Memoization
        memoParameter,
        -- * Utilities
        tableParameter) where

import Control.Exception
import Control.Concurrent.MVar
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fix
import Control.Monad.Fail
import qualified Control.Monad.Catch as MC
import Control.Applicative

import Data.IORef
import qualified Data.IntMap as M
import Data.Array

import Simulation.Aivika.Trans.Exception
import Simulation.Aivika.Trans.Generator
import Simulation.Aivika.Trans.Comp
import Simulation.Aivika.Trans.DES
import Simulation.Aivika.Trans.Internal.Types
import Simulation.Aivika.Trans.Internal.Specs
import {-# SOURCE #-} Simulation.Aivika.Trans.Concurrent.MVar

instance Monad m => Monad (Parameter m) where

  {-# INLINE (>>=) #-}
  (Parameter Run m -> m a
m) >>= :: forall a b. Parameter m a -> (a -> Parameter m b) -> Parameter m b
>>= a -> Parameter m b
k =
    forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r -> 
    do a
a <- Run m -> m a
m Run m
r
       let Parameter Run m -> m b
m' = a -> Parameter m b
k a
a
       Run m -> m b
m' Run m
r

-- | Run the parameter using the specified specs.
runParameter :: MonadDES m => Parameter m a -> Specs m -> m a
{-# INLINABLE runParameter #-}
runParameter :: forall (m :: * -> *) a.
MonadDES m =>
Parameter m a -> Specs m -> m a
runParameter (Parameter Run m -> m a
m) Specs m
sc =
  do EventQueue m
q <- forall (m :: * -> *).
EventQueueing m =>
Specs m -> m (EventQueue m)
newEventQueue Specs m
sc
     Generator m
g <- forall (m :: * -> *).
MonadGenerator m =>
GeneratorType m -> m (Generator m)
newGenerator forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Specs m -> GeneratorType m
spcGeneratorType Specs m
sc
     Run m -> m a
m Run { runSpecs :: Specs m
runSpecs = Specs m
sc,
             runIndex :: Int
runIndex = Int
1,
             runCount :: Int
runCount = Int
1,
             runEventQueue :: EventQueue m
runEventQueue = EventQueue m
q,
             runGenerator :: Generator m
runGenerator = Generator m
g }

-- | Run the given number of parameters using the specified specs, 
--   where each parameter is distinguished by its index 'parameterIndex'.
runParameters :: MonadDES m => Parameter m a -> Specs m -> Int -> [m a]
{-# INLINABLE runParameters #-}
runParameters :: forall (m :: * -> *) a.
MonadDES m =>
Parameter m a -> Specs m -> Int -> [m a]
runParameters (Parameter Run m -> m a
m) Specs m
sc Int
runs = forall a b. (a -> b) -> [a] -> [b]
map Int -> m a
f [Int
1 .. Int
runs]
  where f :: Int -> m a
f Int
i = do EventQueue m
q <- forall (m :: * -> *).
EventQueueing m =>
Specs m -> m (EventQueue m)
newEventQueue Specs m
sc
                 Generator m
g <- forall (m :: * -> *).
MonadGenerator m =>
GeneratorType m -> m (Generator m)
newGenerator forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). Specs m -> GeneratorType m
spcGeneratorType Specs m
sc
                 Run m -> m a
m Run { runSpecs :: Specs m
runSpecs = Specs m
sc,
                         runIndex :: Int
runIndex = Int
i,
                         runCount :: Int
runCount = Int
runs,
                         runEventQueue :: EventQueue m
runEventQueue = EventQueue m
q,
                         runGenerator :: Generator m
runGenerator = Generator m
g }

-- | Return the run index for the current simulation.
simulationIndex :: Monad m => Parameter m Int
{-# INLINE simulationIndex #-}
simulationIndex :: forall (m :: * -> *). Monad m => Parameter m Int
simulationIndex = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Int
runIndex

-- | Return the number of simulations currently run.
simulationCount :: Monad m => Parameter m Int
{-# INLINE simulationCount #-}
simulationCount :: forall (m :: * -> *). Monad m => Parameter m Int
simulationCount = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Int
runCount

-- | Return the simulation specs.
simulationSpecs :: Monad m => Parameter m (Specs m)
{-# INLINE simulationSpecs #-}
simulationSpecs :: forall (m :: * -> *). Monad m => Parameter m (Specs m)
simulationSpecs = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Specs m
runSpecs

-- | Return the random number generator for the simulation run.
generatorParameter :: Monad m => Parameter m (Generator m)
{-# INLINE generatorParameter #-}
generatorParameter :: forall (m :: * -> *). Monad m => Parameter m (Generator m)
generatorParameter = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Generator m
runGenerator

instance Functor m => Functor (Parameter m) where
  
  {-# INLINE fmap #-}
  fmap :: forall a b. (a -> b) -> Parameter m a -> Parameter m b
fmap a -> b
f (Parameter Run m -> m a
x) = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ Run m -> m a
x Run m
r

instance Applicative m => Applicative (Parameter m) where
  
  {-# INLINE pure #-}
  pure :: forall a. a -> Parameter m a
pure = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
  
  {-# INLINE (<*>) #-}
  (Parameter Run m -> m (a -> b)
x) <*> :: forall a b. Parameter m (a -> b) -> Parameter m a -> Parameter m b
<*> (Parameter Run m -> m a
y) = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r -> Run m -> m (a -> b)
x Run m
r forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Run m -> m a
y Run m
r

instance Monad m => MonadFail (Parameter m) where

  {-# INLINE fail #-}
  fail :: forall a. String -> Parameter m a
fail = forall a. HasCallStack => String -> a
error

liftMP :: Monad m => (a -> b) -> Parameter m a -> Parameter m b
{-# INLINE liftMP #-}
liftMP :: forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP a -> b
f (Parameter Run m -> m a
x) =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r -> do { a
a <- Run m -> m a
x Run m
r; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b
f a
a }

liftM2P :: Monad m => (a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
{-# INLINE liftM2P #-}
liftM2P :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P a -> b -> c
f (Parameter Run m -> m a
x) (Parameter Run m -> m b
y) =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r -> do { a
a <- Run m -> m a
x Run m
r; b
b <- Run m -> m b
y Run m
r; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b }

instance (Num a, Monad m) => Num (Parameter m a) where

  {-# INLINE (+) #-}
  Parameter m a
x + :: Parameter m a -> Parameter m a -> Parameter m a
+ Parameter m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P forall a. Num a => a -> a -> a
(+) Parameter m a
x Parameter m a
y

  {-# INLINE (-) #-}
  Parameter m a
x - :: Parameter m a -> Parameter m a -> Parameter m a
- Parameter m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P (-) Parameter m a
x Parameter m a
y

  {-# INLINE (*) #-}
  Parameter m a
x * :: Parameter m a -> Parameter m a -> Parameter m a
* Parameter m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P forall a. Num a => a -> a -> a
(*) Parameter m a
x Parameter m a
y

  {-# INLINE negate #-}
  negate :: Parameter m a -> Parameter m a
negate = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Num a => a -> a
negate

  {-# INLINE abs #-}
  abs :: Parameter m a -> Parameter m a
abs = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Num a => a -> a
abs

  {-# INLINE signum #-}
  signum :: Parameter m a -> Parameter m a
signum = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Num a => a -> a
signum

  {-# INLINE fromInteger #-}
  fromInteger :: Integer -> Parameter m a
fromInteger Integer
i = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
i

instance (Fractional a, Monad m) => Fractional (Parameter m a) where

  {-# INLINE (/) #-}
  Parameter m a
x / :: Parameter m a -> Parameter m a -> Parameter m a
/ Parameter m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P forall a. Fractional a => a -> a -> a
(/) Parameter m a
x Parameter m a
y

  {-# INLINE recip #-}
  recip :: Parameter m a -> Parameter m a
recip = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Fractional a => a -> a
recip

  {-# INLINE fromRational #-}
  fromRational :: Rational -> Parameter m a
fromRational Rational
t = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Fractional a => Rational -> a
fromRational Rational
t

instance (Floating a, Monad m) => Floating (Parameter m a) where

  {-# INLINE pi #-}
  pi :: Parameter m a
pi = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Floating a => a
pi

  {-# INLINE exp #-}
  exp :: Parameter m a -> Parameter m a
exp = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
exp

  {-# INLINE log #-}
  log :: Parameter m a -> Parameter m a
log = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
log

  {-# INLINE sqrt #-}
  sqrt :: Parameter m a -> Parameter m a
sqrt = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
sqrt

  {-# INLINE (**) #-}
  Parameter m a
x ** :: Parameter m a -> Parameter m a -> Parameter m a
** Parameter m a
y = forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> Parameter m a -> Parameter m b -> Parameter m c
liftM2P forall a. Floating a => a -> a -> a
(**) Parameter m a
x Parameter m a
y

  {-# INLINE sin #-}
  sin :: Parameter m a -> Parameter m a
sin = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
sin

  {-# INLINE cos #-}
  cos :: Parameter m a -> Parameter m a
cos = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
cos

  {-# INLINE tan #-}
  tan :: Parameter m a -> Parameter m a
tan = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
tan

  {-# INLINE asin #-}
  asin :: Parameter m a -> Parameter m a
asin = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
asin

  {-# INLINE acos #-}
  acos :: Parameter m a -> Parameter m a
acos = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
acos

  {-# INLINE atan #-}
  atan :: Parameter m a -> Parameter m a
atan = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
atan

  {-# INLINE sinh #-}
  sinh :: Parameter m a -> Parameter m a
sinh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
sinh

  {-# INLINE cosh #-}
  cosh :: Parameter m a -> Parameter m a
cosh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
cosh

  {-# INLINE tanh #-}
  tanh :: Parameter m a -> Parameter m a
tanh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
tanh

  {-# INLINE asinh #-}
  asinh :: Parameter m a -> Parameter m a
asinh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
asinh

  {-# INLINE acosh #-}
  acosh :: Parameter m a -> Parameter m a
acosh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
acosh

  {-# INLINE atanh #-}
  atanh :: Parameter m a -> Parameter m a
atanh = forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Parameter m a -> Parameter m b
liftMP forall a. Floating a => a -> a
atanh

instance MonadTrans Parameter where

  {-# INLINE lift #-}
  lift :: forall (m :: * -> *) a. Monad m => m a -> Parameter m a
lift = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

instance MonadIO m => MonadIO (Parameter m) where
  
  {-# INLINE liftIO #-}
  liftIO :: forall a. IO a -> Parameter m a
liftIO = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance Monad m => MonadCompTrans Parameter m where

  {-# INLINE liftComp #-}
  liftComp :: forall a. m a -> Parameter m a
liftComp = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const

-- | A type class to lift the parameters into other computations.
class ParameterLift t m where
  
  -- | Lift the specified 'Parameter' computation into another computation.
  liftParameter :: Parameter m a -> t m a

instance Monad m => ParameterLift Parameter m where
  
  {-# INLINE liftParameter #-}
  liftParameter :: forall a. Parameter m a -> Parameter m a
liftParameter = forall a. a -> a
id
    
-- | Exception handling within 'Parameter' computations.
catchParameter :: (MonadException m, Exception e) => Parameter m a -> (e -> Parameter m a) -> Parameter m a
{-# INLINABLE catchParameter #-}
catchParameter :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Parameter m a -> (e -> Parameter m a) -> Parameter m a
catchParameter (Parameter Run m -> m a
m) e -> Parameter m a
h =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r -> 
  forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
m a -> (e -> m a) -> m a
catchComp (Run m -> m a
m Run m
r) forall a b. (a -> b) -> a -> b
$ \e
e ->
  let Parameter Run m -> m a
m' = e -> Parameter m a
h e
e in Run m -> m a
m' Run m
r
                           
-- | A computation with finalization part like the 'finally' function.
finallyParameter :: MonadException m => Parameter m a -> Parameter m b -> Parameter m a
{-# INLINABLE finallyParameter #-}
finallyParameter :: forall (m :: * -> *) a b.
MonadException m =>
Parameter m a -> Parameter m b -> Parameter m a
finallyParameter (Parameter Run m -> m a
m) (Parameter Run m -> m b
m') =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  forall (m :: * -> *) a b. MonadException m => m a -> m b -> m a
finallyComp (Run m -> m a
m Run m
r) (Run m -> m b
m' Run m
r)

-- | Like the standard 'throw' function.
throwParameter :: (MonadException m, Exception e) => e -> Parameter m a
{-# INLINABLE throwParameter #-}
throwParameter :: forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Parameter m a
throwParameter e
e =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> m a
throwComp e
e

-- | Runs an action with asynchronous exceptions disabled.
maskParameter :: MC.MonadMask m => ((forall a. Parameter m a -> Parameter m a) -> Parameter m b) -> Parameter m b
{-# INLINABLE maskParameter #-}
maskParameter :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
maskParameter (forall a. Parameter m a -> Parameter m a) -> Parameter m b
a =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.mask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
  forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r ((forall a. Parameter m a -> Parameter m a) -> Parameter m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Parameter m a -> Parameter m a
q forall a. m a -> m a
u)
  where q :: (m a -> m a) -> Parameter m a -> Parameter m a
q m a -> m a
u (Parameter Run m -> m a
b) = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> m a
b)

-- | Like 'maskParameter', but the masked computation is not interruptible.
uninterruptibleMaskParameter :: MC.MonadMask m => ((forall a. Parameter m a -> Parameter m a) -> Parameter m b) -> Parameter m b
{-# INLINABLE uninterruptibleMaskParameter #-}
uninterruptibleMaskParameter :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
uninterruptibleMaskParameter (forall a. Parameter m a -> Parameter m a) -> Parameter m b
a =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r ->
  forall (m :: * -> *) b.
MonadMask m =>
((forall a. m a -> m a) -> m b) -> m b
MC.uninterruptibleMask forall a b. (a -> b) -> a -> b
$ \forall a. m a -> m a
u ->
  forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r ((forall a. Parameter m a -> Parameter m a) -> Parameter m b
a forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *} {a} {a}.
(m a -> m a) -> Parameter m a -> Parameter m a
q forall a. m a -> m a
u)
  where q :: (m a -> m a) -> Parameter m a -> Parameter m a
q m a -> m a
u (Parameter Run m -> m a
b) = forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter (m a -> m a
u forall b c a. (b -> c) -> (a -> b) -> a -> c
. Run m -> m a
b)

-- | An implementation of 'generalBracket'.
generalBracketParameter :: MC.MonadMask m
                           => Parameter m a
                           -> (a -> MC.ExitCase b -> Parameter m c)
                           -> (a -> Parameter m b)
                           -> Parameter m (b, c)
{-# INLINABLE generalBracketParameter #-}
generalBracketParameter :: forall (m :: * -> *) a b c.
MonadMask m =>
Parameter m a
-> (a -> ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
generalBracketParameter Parameter m a
acquire a -> ExitCase b -> Parameter m c
release a -> Parameter m b
use =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r -> do
    forall (m :: * -> *) a b c.
MonadMask m =>
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c)
MC.generalBracket
      (forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r Parameter m a
acquire)
      (\a
resource ExitCase b
e -> forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r forall a b. (a -> b) -> a -> b
$ a -> ExitCase b -> Parameter m c
release a
resource ExitCase b
e)
      (\a
resource -> forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r forall a b. (a -> b) -> a -> b
$ a -> Parameter m b
use a
resource)

instance MonadFix m => MonadFix (Parameter m) where

  {-# INLINE mfix #-}
  mfix :: forall a. (a -> Parameter m a) -> Parameter m a
mfix a -> Parameter m a
f = 
    forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r ->
    do { rec { a
a <- forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r (a -> Parameter m a
f a
a) }; forall (m :: * -> *) a. Monad m => a -> m a
return a
a }

instance MonadException m => MC.MonadThrow (Parameter m) where

  {-# INLINE throwM #-}
  throwM :: forall e a. Exception e => e -> Parameter m a
throwM = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> Parameter m a
throwParameter

instance MonadException m => MC.MonadCatch (Parameter m) where

  {-# INLINE catch #-}
  catch :: forall e a.
Exception e =>
Parameter m a -> (e -> Parameter m a) -> Parameter m a
catch = forall (m :: * -> *) e a.
(MonadException m, Exception e) =>
Parameter m a -> (e -> Parameter m a) -> Parameter m a
catchParameter

instance (MonadException m, MC.MonadMask m) => MC.MonadMask (Parameter m) where

  {-# INLINE mask #-}
  mask :: forall b.
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
mask = forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
maskParameter
  
  {-# INLINE uninterruptibleMask #-}
  uninterruptibleMask :: forall b.
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
uninterruptibleMask = forall (m :: * -> *) b.
MonadMask m =>
((forall a. Parameter m a -> Parameter m a) -> Parameter m b)
-> Parameter m b
uninterruptibleMaskParameter
  
  {-# INLINE generalBracket #-}
  generalBracket :: forall a b c.
Parameter m a
-> (a -> ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
generalBracket = forall (m :: * -> *) a b c.
MonadMask m =>
Parameter m a
-> (a -> ExitCase b -> Parameter m c)
-> (a -> Parameter m b)
-> Parameter m (b, c)
generalBracketParameter

-- | Memoize the 'Parameter' computation, always returning the same value
-- within a simulation run. However, the value will be recalculated for other
-- simulation runs. Also it is thread-safe when different simulation runs
-- are executed in parallel on physically different operating system threads.
memoParameter :: (MonadComp m, MonadIO m, MC.MonadMask m) => Parameter m a -> m (Parameter m a)
memoParameter :: forall (m :: * -> *) a.
(MonadComp m, MonadIO m, MonadMask m) =>
Parameter m a -> m (Parameter m a)
memoParameter Parameter m a
x = 
  do MVar ()
lock <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (MVar a)
newMVar ()
     IORef (IntMap a)
dict <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO (IORef a)
newIORef forall a. IntMap a
M.empty
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ \Run m
r ->
       do let i :: Int
i = forall (m :: * -> *). Run m -> Int
runIndex Run m
r
          IntMap a
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (IntMap a)
dict
          if forall a. Int -> IntMap a -> Bool
M.member Int
i IntMap a
m
            then do let Just a
v = forall a. Int -> IntMap a -> Maybe a
M.lookup Int
i IntMap a
m
                    forall (m :: * -> *) a. Monad m => a -> m a
return a
v
            else forall (m :: * -> *) a b.
(MonadComp m, MonadIO m, MonadMask m) =>
MVar a -> (a -> m b) -> m b
withMVarComp MVar ()
lock forall a b. (a -> b) -> a -> b
$ 
                 \() -> do { IntMap a
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef (IntMap a)
dict;
                             if forall a. Int -> IntMap a -> Bool
M.member Int
i IntMap a
m
                             then do let Just a
v = forall a. Int -> IntMap a -> Maybe a
M.lookup Int
i IntMap a
m
                                     forall (m :: * -> *) a. Monad m => a -> m a
return a
v
                             else do a
v <- forall (m :: * -> *) a. Run m -> Parameter m a -> m a
invokeParameter Run m
r Parameter m a
x
                                     forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> a -> IO ()
writeIORef IORef (IntMap a)
dict forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> IntMap a -> IntMap a
M.insert Int
i a
v IntMap a
m
                                     forall (m :: * -> *) a. Monad m => a -> m a
return a
v }

-- | Return a parameter which value is taken consequently from the specified table
-- based on the run index of the current simulation starting from zero. After all
-- values from the table are used, it takes again the first value of the table,
-- then the second one and so on.
tableParameter :: Monad m => Array Int a -> Parameter m a
{-# INLINABLE tableParameter #-}
tableParameter :: forall (m :: * -> *) a. Monad m => Array Int a -> Parameter m a
tableParameter Array Int a
t =
  do Int
i <- forall (m :: * -> *). Monad m => Parameter m Int
simulationIndex
     forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Array Int a
t forall i e. Ix i => Array i e -> i -> e
! (((Int
i forall a. Num a => a -> a -> a
- Int
i1) forall a. Integral a => a -> a -> a
`mod` Int
n) forall a. Num a => a -> a -> a
+ Int
i1)
  where (Int
i1, Int
i2) = forall i e. Array i e -> (i, i)
bounds Array Int a
t
        n :: Int
n = Int
i2 forall a. Num a => a -> a -> a
- Int
i1 forall a. Num a => a -> a -> a
+ Int
1

-- | Computation that returns the start simulation time.
starttime :: Monad m => Parameter m Double
{-# INLINE starttime #-}
starttime :: forall (m :: * -> *). Monad m => Parameter m Double
starttime =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Specs m -> Double
spcStartTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Specs m
runSpecs

-- | Computation that returns the final simulation time.
stoptime :: Monad m => Parameter m Double
{-# INLINE stoptime #-}
stoptime :: forall (m :: * -> *). Monad m => Parameter m Double
stoptime =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Specs m -> Double
spcStopTime forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Specs m
runSpecs

-- | Computation that returns the integration time step.
dt :: Monad m => Parameter m Double
{-# INLINE dt #-}
dt :: forall (m :: * -> *). Monad m => Parameter m Double
dt =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Specs m -> Double
spcDT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> Specs m
runSpecs

-- | Return the event queue.
simulationEventQueue :: Monad m => Parameter m (EventQueue m)
{-# INLINE simulationEventQueue #-}
simulationEventQueue :: forall (m :: * -> *). Monad m => Parameter m (EventQueue m)
simulationEventQueue =
  forall (m :: * -> *) a. (Run m -> m a) -> Parameter m a
Parameter forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). Run m -> EventQueue m
runEventQueue