{-# LANGUAGE MultiParamTypeClasses, RecursiveDo #-}

-- |
-- Module     : Simulation.Aivika.Composite
-- 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
--
-- It defines the 'Composite' monad that allows constructing components which
-- can be then destroyed in case of need.
--
module Simulation.Aivika.Composite
       (-- * Composite Monad
        Composite,
        CompositeLift(..),
        runComposite,
        runComposite_,
        runCompositeInStartTime_,
        runCompositeInStopTime_,
        disposableComposite) where

import Data.Monoid

import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Fix
import Control.Monad.Fail
import Control.Applicative

import Simulation.Aivika.Parameter
import Simulation.Aivika.Simulation
import Simulation.Aivika.Dynamics
import Simulation.Aivika.Event

-- | It represents a composite which can be then destroyed in case of need.
newtype Composite a = Composite { Composite a -> DisposableEvent -> Event (a, DisposableEvent)
runComposite :: DisposableEvent -> Event (a, DisposableEvent)
                                  -- ^ Run the computation returning the result
                                  -- and some 'DisposableEvent' that being applied
                                  -- destroys the composite, for example, unsubscribes
                                  -- from signals or cancels the processes.
                                  --
                                }

-- | Like 'runComposite' but retains the composite parts during the simulation.
runComposite_ :: Composite a -> Event a
runComposite_ :: Composite a -> Event a
runComposite_ Composite a
m =
  do (a
a, DisposableEvent
_) <- Composite a -> DisposableEvent -> Event (a, DisposableEvent)
forall a.
Composite a -> DisposableEvent -> Event (a, DisposableEvent)
runComposite Composite a
m DisposableEvent
forall a. Monoid a => a
mempty
     a -> Event a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Like 'runComposite_' but runs the computation in the start time.
runCompositeInStartTime_ :: Composite a -> Simulation a
runCompositeInStartTime_ :: Composite a -> Simulation a
runCompositeInStartTime_ = Event a -> Simulation a
forall a. Event a -> Simulation a
runEventInStartTime (Event a -> Simulation a)
-> (Composite a -> Event a) -> Composite a -> Simulation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Composite a -> Event a
forall a. Composite a -> Event a
runComposite_

-- | Like 'runComposite_' but runs the computation in the stop time.
runCompositeInStopTime_ :: Composite a -> Simulation a
runCompositeInStopTime_ :: Composite a -> Simulation a
runCompositeInStopTime_ = Event a -> Simulation a
forall a. Event a -> Simulation a
runEventInStopTime (Event a -> Simulation a)
-> (Composite a -> Event a) -> Composite a -> Simulation a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Composite a -> Event a
forall a. Composite a -> Event a
runComposite_

-- | When destroying the composite, the specified action will be applied.
disposableComposite :: DisposableEvent -> Composite ()
disposableComposite :: DisposableEvent -> Composite ()
disposableComposite DisposableEvent
h = (DisposableEvent -> Event ((), DisposableEvent)) -> Composite ()
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event ((), DisposableEvent)) -> Composite ())
-> (DisposableEvent -> Event ((), DisposableEvent)) -> Composite ()
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 -> ((), DisposableEvent) -> Event ((), DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), DisposableEvent
h0 DisposableEvent -> DisposableEvent -> DisposableEvent
forall a. Semigroup a => a -> a -> a
<> DisposableEvent
h)

instance Functor Composite where

  fmap :: (a -> b) -> Composite a -> Composite b
fmap a -> b
f (Composite DisposableEvent -> Event (a, DisposableEvent)
m) =
    (DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (b, DisposableEvent)) -> Composite b)
-> (DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do (a
a, DisposableEvent
h) <- DisposableEvent -> Event (a, DisposableEvent)
m DisposableEvent
h0
       (b, DisposableEvent) -> Event (b, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a, DisposableEvent
h)

instance Applicative Composite where

  pure :: a -> Composite a
pure = a -> Composite a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: Composite (a -> b) -> Composite a -> Composite b
(<*>) = Composite (a -> b) -> Composite a -> Composite b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad Composite where

  return :: a -> Composite a
return a
a = (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 -> (a, DisposableEvent) -> Event (a, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)

  (Composite DisposableEvent -> Event (a, DisposableEvent)
m) >>= :: Composite a -> (a -> Composite b) -> Composite b
>>= a -> Composite b
k =
    (DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (b, DisposableEvent)) -> Composite b)
-> (DisposableEvent -> Event (b, DisposableEvent)) -> Composite b
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do (a
a, DisposableEvent
h) <- DisposableEvent -> Event (a, DisposableEvent)
m DisposableEvent
h0
       let Composite DisposableEvent -> Event (b, DisposableEvent)
m' = a -> Composite b
k a
a
       (b
b, DisposableEvent
h') <- DisposableEvent -> Event (b, DisposableEvent)
m' DisposableEvent
h
       (b, DisposableEvent) -> Event (b, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, DisposableEvent
h')

instance MonadFail Composite where
  fail :: String -> Composite a
fail = String -> Composite a
forall a. HasCallStack => String -> a
error

instance MonadIO Composite where

  liftIO :: IO a -> Composite a
liftIO IO a
m =
    (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do a
a <- IO a -> Event a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m
       (a, DisposableEvent) -> Event (a, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)

instance MonadFix Composite where

  mfix :: (a -> Composite a) -> Composite a
mfix a -> Composite a
f =
    (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do rec (a
a, DisposableEvent
h) <- Composite a -> DisposableEvent -> Event (a, DisposableEvent)
forall a.
Composite a -> DisposableEvent -> Event (a, DisposableEvent)
runComposite (a -> Composite a
f a
a) DisposableEvent
h0
       (a, DisposableEvent) -> Event (a, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h)

instance ParameterLift Composite where

  liftParameter :: Parameter a -> Composite a
liftParameter Parameter a
m =
    (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do a
a <- Parameter a -> Event a
forall (m :: * -> *) a. ParameterLift m => Parameter a -> m a
liftParameter Parameter a
m
       (a, DisposableEvent) -> Event (a, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)

instance SimulationLift Composite where

  liftSimulation :: Simulation a -> Composite a
liftSimulation Simulation a
m =
    (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do a
a <- Simulation a -> Event a
forall (m :: * -> *) a. SimulationLift m => Simulation a -> m a
liftSimulation Simulation a
m
       (a, DisposableEvent) -> Event (a, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)

instance DynamicsLift Composite where

  liftDynamics :: Dynamics a -> Composite a
liftDynamics Dynamics a
m =
    (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do a
a <- Dynamics a -> Event a
forall (m :: * -> *) a. DynamicsLift m => Dynamics a -> m a
liftDynamics Dynamics a
m
       (a, DisposableEvent) -> Event (a, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)

instance EventLift Composite where

  liftEvent :: Event a -> Composite a
liftEvent Event a
m =
    (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a.
(DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
Composite ((DisposableEvent -> Event (a, DisposableEvent)) -> Composite a)
-> (DisposableEvent -> Event (a, DisposableEvent)) -> Composite a
forall a b. (a -> b) -> a -> b
$ \DisposableEvent
h0 ->
    do a
a <- Event a -> Event a
forall (m :: * -> *) a. EventLift m => Event a -> m a
liftEvent Event a
m
       (a, DisposableEvent) -> Event (a, DisposableEvent)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a, DisposableEvent
h0)

-- | A type class to lift the 'Composite' computation to other computations.
class CompositeLift m where
  
  -- | Lift the specified 'Composite' computation to another computation.
  liftComposite :: Composite a -> m a

instance CompositeLift Composite where
  liftComposite :: Composite a -> Composite a
liftComposite = Composite a -> Composite a
forall a. a -> a
id