{-----------------------------------------------------------------------------
    reactive-banana
------------------------------------------------------------------------------}
module Reactive.Banana.Types (
    -- | Primitive types.
    Event(..), Behavior(..),
    Moment(..), MomentIO(..), MonadMoment(..),
    Future(..),
    ) where

import Data.Semigroup
import Control.Applicative
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Fix
import Data.String (IsString(..))

import qualified Reactive.Banana.Internal.Combinators as Prim

{-----------------------------------------------------------------------------
    Types
------------------------------------------------------------------------------}

{-| @Event a@ represents a stream of events as they occur in time.
Semantically, you can think of @Event a@ as an infinite list of values
that are tagged with their corresponding time of occurrence,

> type Event a = [(Time,a)]

Each pair is called an /event occurrence/.
Note that within a single event stream,
no two event occurrences may happen at the same time.

<<doc/frp-event.png>>
-}
newtype Event a = E { Event a -> Event a
unE :: Prim.Event a }
-- Invariant: The empty list `[]` never occurs as event value.

-- | The function 'fmap' applies a function @f@ to every value.
-- Semantically,
--
-- > fmap :: (a -> b) -> Event a -> Event b
-- > fmap f e = [(time, f a) | (time, a) <- e]
instance Functor Event where
    fmap :: (a -> b) -> Event a -> Event b
fmap a -> b
f = Event b -> Event b
forall a. Event a -> Event a
E (Event b -> Event b) -> (Event a -> Event b) -> Event a -> Event b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Event a -> Event b
forall a b. (a -> b) -> Event a -> Event b
Prim.mapE a -> b
f (Event a -> Event b) -> (Event a -> Event a) -> Event a -> Event b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event a -> Event a
forall a. Event a -> Event a
unE

-- | The combinator '<>' merges two event streams of the same type.
-- In case of simultaneous occurrences,
-- the events are combined with the underlying 'Semigroup' operation.
-- Semantically,
--
-- > (<>) :: Event a -> Event a -> Event a
-- > (<>) ex ey = unionWith (<>) ex ey
instance Semigroup a => Semigroup (Event a) where
    Event a
x <> :: Event a -> Event a -> Event a
<> Event a
y = Event a -> Event a
forall a. Event a -> Event a
E (Event a -> Event a) -> Event a -> Event a
forall a b. (a -> b) -> a -> b
$ (a -> a)
-> (a -> a) -> (a -> a -> a) -> Event a -> Event a -> Event a
forall a c b.
(a -> c)
-> (b -> c) -> (a -> b -> c) -> Event a -> Event b -> Event c
Prim.mergeWith a -> a
forall a. a -> a
id a -> a
forall a. a -> a
id a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) (Event a -> Event a
forall a. Event a -> Event a
unE Event a
x) (Event a -> Event a
forall a. Event a -> Event a
unE Event a
y)

-- | The combinator 'mempty' represents an event that never occurs.
-- It is a synonym,
--
-- > mempty :: Event a
-- > mempty = never
instance Semigroup a => Monoid (Event a) where
    mempty :: Event a
mempty  = Event a -> Event a
forall a. Event a -> Event a
E (Event a -> Event a) -> Event a -> Event a
forall a b. (a -> b) -> a -> b
$ Event a
forall a. Event a
Prim.never
    mappend :: Event a -> Event a -> Event a
mappend = Event a -> Event a -> Event a
forall a. Semigroup a => a -> a -> a
(<>)


{-| @Behavior a@ represents a value that varies in time.
Semantically, you can think of it as a function

> type Behavior a = Time -> a

<<doc/frp-behavior.png>>
-}
newtype Behavior a = B { Behavior a -> Behavior a
unB :: Prim.Behavior a }

-- | The function 'pure' returns a value that is constant in time. Semantically,
--
-- > pure     :: a -> Behavior a
-- > pure x    = \time -> x
--
-- The combinator '<*>' applies a time-varying function to a time-varying value.
--
-- > (<*>)    :: Behavior (a -> b) -> Behavior a -> Behavior b
-- > fx <*> bx = \time -> fx time $ bx time
instance Applicative Behavior where
    pure :: a -> Behavior a
pure a
x    = Behavior a -> Behavior a
forall a. Behavior a -> Behavior a
B (Behavior a -> Behavior a) -> Behavior a -> Behavior a
forall a b. (a -> b) -> a -> b
$ a -> Behavior a
forall a. a -> Behavior a
Prim.pureB a
x
    Behavior (a -> b)
bf <*> :: Behavior (a -> b) -> Behavior a -> Behavior b
<*> Behavior a
bx = Behavior b -> Behavior b
forall a. Behavior a -> Behavior a
B (Behavior b -> Behavior b) -> Behavior b -> Behavior b
forall a b. (a -> b) -> a -> b
$ Behavior (a -> b) -> Behavior a -> Behavior b
forall a b. Behavior (a -> b) -> Behavior a -> Behavior b
Prim.applyB (Behavior (a -> b) -> Behavior (a -> b)
forall a. Behavior a -> Behavior a
unB Behavior (a -> b)
bf) (Behavior a -> Behavior a
forall a. Behavior a -> Behavior a
unB Behavior a
bx)

-- | The function 'fmap' applies a function @f@ at every point in time.
-- Semantically,
--
-- > fmap :: (a -> b) -> Behavior a -> Behavior b
-- > fmap f b = \time -> f (b time)
instance Functor Behavior where
    fmap :: (a -> b) -> Behavior a -> Behavior b
fmap = (a -> b) -> Behavior a -> Behavior b
forall (f :: * -> *) a b. Applicative f => (a -> b) -> f a -> f b
liftA

instance Semigroup a => Semigroup (Behavior a) where
  <> :: Behavior a -> Behavior a -> Behavior a
(<>) = (a -> a -> a) -> Behavior a -> Behavior a -> Behavior a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)

instance (Semigroup a, Monoid a) => Monoid (Behavior a) where
  mempty :: Behavior a
mempty = a -> Behavior a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
  mappend :: Behavior a -> Behavior a -> Behavior a
mappend = Behavior a -> Behavior a -> Behavior a
forall a. Semigroup a => a -> a -> a
(<>)

instance Num a => Num (Behavior a) where
    + :: Behavior a -> Behavior a -> Behavior a
(+) = (a -> a -> a) -> Behavior a -> Behavior a -> Behavior a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(+)
    (-) = (a -> a -> a) -> Behavior a -> Behavior a -> Behavior a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
    * :: Behavior a -> Behavior a -> Behavior a
(*) = (a -> a -> a) -> Behavior a -> Behavior a -> Behavior a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Num a => a -> a -> a
(*)
    abs :: Behavior a -> Behavior a
abs = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
    signum :: Behavior a -> Behavior a
signum = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum
    fromInteger :: Integer -> Behavior a
fromInteger = a -> Behavior a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Behavior a) -> (Integer -> a) -> Integer -> Behavior a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
    negate :: Behavior a -> Behavior a
negate = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate

instance Fractional a => Fractional (Behavior a) where
    / :: Behavior a -> Behavior a -> Behavior a
(/) = (a -> a -> a) -> Behavior a -> Behavior a -> Behavior a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Fractional a => a -> a -> a
(/)
    fromRational :: Rational -> Behavior a
fromRational = a -> Behavior a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Behavior a) -> (Rational -> a) -> Rational -> Behavior a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
    recip :: Behavior a -> Behavior a
recip = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip

instance Floating a => Floating (Behavior a) where
    ** :: Behavior a -> Behavior a -> Behavior a
(**) = (a -> a -> a) -> Behavior a -> Behavior a -> Behavior a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
(**)
    acos :: Behavior a -> Behavior a
acos = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acos
    acosh :: Behavior a -> Behavior a
acosh = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
acosh
    asin :: Behavior a -> Behavior a
asin = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asin
    asinh :: Behavior a -> Behavior a
asinh = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
asinh
    atan :: Behavior a -> Behavior a
atan = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atan
    atanh :: Behavior a -> Behavior a
atanh = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
atanh
    cos :: Behavior a -> Behavior a
cos = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cos
    cosh :: Behavior a -> Behavior a
cosh = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
cosh
    exp :: Behavior a -> Behavior a
exp = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
exp
    log :: Behavior a -> Behavior a
log = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
log
    logBase :: Behavior a -> Behavior a -> Behavior a
logBase = (a -> a -> a) -> Behavior a -> Behavior a -> Behavior a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Floating a => a -> a -> a
logBase
    pi :: Behavior a
pi = a -> Behavior a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Floating a => a
pi
    sin :: Behavior a -> Behavior a
sin = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sin
    sinh :: Behavior a -> Behavior a
sinh = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sinh
    sqrt :: Behavior a -> Behavior a
sqrt = (a -> a) -> Behavior a -> Behavior a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Floating a => a -> a
sqrt

instance IsString a => IsString (Behavior a) where
    fromString :: String -> Behavior a
fromString = a -> Behavior a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Behavior a) -> (String -> a) -> String -> Behavior a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString

-- | The 'Future' monad is just a helper type for the 'changes' function.
--
-- A value of type @Future a@ is only available in the context
-- of a 'reactimate' but not during event processing.
newtype Future a = F { Future a -> Future a
unF :: Prim.Future a }

-- boilerplate class instances
instance Functor Future where fmap :: (a -> b) -> Future a -> Future b
fmap a -> b
f = Future b -> Future b
forall a. Future a -> Future a
F (Future b -> Future b)
-> (Future a -> Future b) -> Future a -> Future b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> IO a -> Future b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (IO a -> Future b) -> (Future a -> IO a) -> Future a -> Future b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Future a -> IO a
forall a. Future a -> Future a
unF

instance Monad Future where
    return :: a -> Future a
return  = Future a -> Future a
forall a. Future a -> Future a
F (Future a -> Future a) -> (a -> Future a) -> a -> Future a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Future a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Future a
m >>= :: Future a -> (a -> Future b) -> Future b
>>= a -> Future b
g = Future b -> Future b
forall a. Future a -> Future a
F (Future b -> Future b) -> Future b -> Future b
forall a b. (a -> b) -> a -> b
$ Future a -> Future a
forall a. Future a -> Future a
unF Future a
m Future a -> (a -> Future b) -> Future b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Future b -> Future b
forall a. Future a -> Future a
unF (Future b -> Future b) -> (a -> Future b) -> a -> Future b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Future b
g

instance Applicative Future where
    pure :: a -> Future a
pure    = Future a -> Future a
forall a. Future a -> Future a
F (Future a -> Future a) -> (a -> Future a) -> a -> Future a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Future a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Future (a -> b)
f <*> :: Future (a -> b) -> Future a -> Future b
<*> Future a
a = Future b -> Future b
forall a. Future a -> Future a
F (Future b -> Future b) -> Future b -> Future b
forall a b. (a -> b) -> a -> b
$ Future (a -> b) -> Future (a -> b)
forall a. Future a -> Future a
unF Future (a -> b)
f Future (a -> b) -> IO a -> Future b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Future a -> IO a
forall a. Future a -> Future a
unF Future a
a


{-| The 'Moment' monad denotes a /pure/ computation that happens
at one particular moment in time. Semantically, it is a reader monad

> type Moment a = Time -> a

When run, the argument tells the time at which this computation happens.

Note that in this context, /time/ really means to /logical time/.
Of course, every calculation on a computer takes some
amount of wall-clock time to complete.
Instead, what is meant here is the time as it relates to
'Event's and 'Behavior's.
We use the fiction that every calculation within the 'Moment'
monad takes zero /logical time/ to perform.
-}
newtype Moment a = M { Moment a -> Moment a
unM :: Prim.Moment a }

{-| The 'MomentIO' monad is used to add inputs and outputs
to an event network.
-}
newtype MomentIO a = MIO { MomentIO a -> Moment a
unMIO :: Prim.Moment a }

instance MonadIO MomentIO where liftIO :: IO a -> MomentIO a
liftIO = Moment a -> MomentIO a
forall a. Moment a -> MomentIO a
MIO (Moment a -> MomentIO a)
-> (IO a -> Moment a) -> IO a -> MomentIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Moment a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

{-| An instance of the 'MonadMoment' class denotes a computation
that happens at one particular moment in time.
Unlike the 'Moment' monad, it need not be pure anymore.
-}
class MonadFix m => MonadMoment m where
    liftMoment :: Moment a -> m a

instance MonadMoment Moment   where liftMoment :: Moment a -> Moment a
liftMoment = Moment a -> Moment a
forall a. a -> a
id
instance MonadMoment MomentIO where liftMoment :: Moment a -> MomentIO a
liftMoment = Moment a -> MomentIO a
forall a. Moment a -> MomentIO a
MIO (Moment a -> MomentIO a)
-> (Moment a -> Moment a) -> Moment a -> MomentIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Moment a -> Moment a
forall a. Moment a -> Moment a
unM

-- boilerplate class instances
instance Functor Moment where fmap :: (a -> b) -> Moment a -> Moment b
fmap a -> b
f = Moment b -> Moment b
forall a. Moment a -> Moment a
M (Moment b -> Moment b)
-> (Moment a -> Moment b) -> Moment a -> Moment b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> ReaderT EventNetwork Build a -> Moment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderT EventNetwork Build a -> Moment b)
-> (Moment a -> ReaderT EventNetwork Build a)
-> Moment a
-> Moment b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Moment a -> ReaderT EventNetwork Build a
forall a. Moment a -> Moment a
unM
instance Monad Moment where
    return :: a -> Moment a
return  = Moment a -> Moment a
forall a. Moment a -> Moment a
M (Moment a -> Moment a) -> (a -> Moment a) -> a -> Moment a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Moment a
forall (m :: * -> *) a. Monad m => a -> m a
return
    Moment a
m >>= :: Moment a -> (a -> Moment b) -> Moment b
>>= a -> Moment b
g = Moment b -> Moment b
forall a. Moment a -> Moment a
M (Moment b -> Moment b) -> Moment b -> Moment b
forall a b. (a -> b) -> a -> b
$ Moment a -> Moment a
forall a. Moment a -> Moment a
unM Moment a
m Moment a -> (a -> Moment b) -> Moment b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Moment b -> Moment b
forall a. Moment a -> Moment a
unM (Moment b -> Moment b) -> (a -> Moment b) -> a -> Moment b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Moment b
g
instance Applicative Moment where
    pure :: a -> Moment a
pure    = Moment a -> Moment a
forall a. Moment a -> Moment a
M (Moment a -> Moment a) -> (a -> Moment a) -> a -> Moment a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Moment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    Moment (a -> b)
f <*> :: Moment (a -> b) -> Moment a -> Moment b
<*> Moment a
a = Moment b -> Moment b
forall a. Moment a -> Moment a
M (Moment b -> Moment b) -> Moment b -> Moment b
forall a b. (a -> b) -> a -> b
$ Moment (a -> b) -> Moment (a -> b)
forall a. Moment a -> Moment a
unM Moment (a -> b)
f Moment (a -> b) -> ReaderT EventNetwork Build a -> Moment b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Moment a -> ReaderT EventNetwork Build a
forall a. Moment a -> Moment a
unM Moment a
a
instance MonadFix Moment where mfix :: (a -> Moment a) -> Moment a
mfix a -> Moment a
f = Moment a -> Moment a
forall a. Moment a -> Moment a
M (Moment a -> Moment a) -> Moment a -> Moment a
forall a b. (a -> b) -> a -> b
$ (a -> Moment a) -> Moment a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (Moment a -> Moment a
forall a. Moment a -> Moment a
unM (Moment a -> Moment a) -> (a -> Moment a) -> a -> Moment a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Moment a
f)

instance Functor MomentIO where fmap :: (a -> b) -> MomentIO a -> MomentIO b
fmap a -> b
f = Moment b -> MomentIO b
forall a. Moment a -> MomentIO a
MIO (Moment b -> MomentIO b)
-> (MomentIO a -> Moment b) -> MomentIO a -> MomentIO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> ReaderT EventNetwork Build a -> Moment b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (ReaderT EventNetwork Build a -> Moment b)
-> (MomentIO a -> ReaderT EventNetwork Build a)
-> MomentIO a
-> Moment b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MomentIO a -> ReaderT EventNetwork Build a
forall a. MomentIO a -> Moment a
unMIO
instance Monad MomentIO where
    return :: a -> MomentIO a
return  = Moment a -> MomentIO a
forall a. Moment a -> MomentIO a
MIO (Moment a -> MomentIO a) -> (a -> Moment a) -> a -> MomentIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Moment a
forall (m :: * -> *) a. Monad m => a -> m a
return
    MomentIO a
m >>= :: MomentIO a -> (a -> MomentIO b) -> MomentIO b
>>= a -> MomentIO b
g = Moment b -> MomentIO b
forall a. Moment a -> MomentIO a
MIO (Moment b -> MomentIO b) -> Moment b -> MomentIO b
forall a b. (a -> b) -> a -> b
$ MomentIO a -> Moment a
forall a. MomentIO a -> Moment a
unMIO MomentIO a
m Moment a -> (a -> Moment b) -> Moment b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= MomentIO b -> Moment b
forall a. MomentIO a -> Moment a
unMIO (MomentIO b -> Moment b) -> (a -> MomentIO b) -> a -> Moment b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MomentIO b
g
instance Applicative MomentIO where
    pure :: a -> MomentIO a
pure    = Moment a -> MomentIO a
forall a. Moment a -> MomentIO a
MIO (Moment a -> MomentIO a) -> (a -> Moment a) -> a -> MomentIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Moment a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    MomentIO (a -> b)
f <*> :: MomentIO (a -> b) -> MomentIO a -> MomentIO b
<*> MomentIO a
a = Moment b -> MomentIO b
forall a. Moment a -> MomentIO a
MIO (Moment b -> MomentIO b) -> Moment b -> MomentIO b
forall a b. (a -> b) -> a -> b
$ MomentIO (a -> b) -> Moment (a -> b)
forall a. MomentIO a -> Moment a
unMIO MomentIO (a -> b)
f Moment (a -> b) -> ReaderT EventNetwork Build a -> Moment b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MomentIO a -> ReaderT EventNetwork Build a
forall a. MomentIO a -> Moment a
unMIO MomentIO a
a
instance MonadFix MomentIO where mfix :: (a -> MomentIO a) -> MomentIO a
mfix a -> MomentIO a
f = Moment a -> MomentIO a
forall a. Moment a -> MomentIO a
MIO (Moment a -> MomentIO a) -> Moment a -> MomentIO a
forall a b. (a -> b) -> a -> b
$ (a -> Moment a) -> Moment a
forall (m :: * -> *) a. MonadFix m => (a -> m a) -> m a
mfix (MomentIO a -> Moment a
forall a. MomentIO a -> Moment a
unMIO (MomentIO a -> Moment a) -> (a -> MomentIO a) -> a -> Moment a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> MomentIO a
f)