-- | Dyna is functional reactive programming library.
-- It describes event streams that are based on callbacks.
-- The event stream can produce something useful with callback that it consumes.
-- Also we have continous signals called @Dyn@ (short for dynamic).
-- The Dyn is sort of observance process of an event stream. For any
-- event that happen on event stream we remember that value and produce it
-- at any time until the next event will happen.
--
-- # Events
--
-- The event stream is just callback consumer funtion:
--
-- > newtype Evt m a = Evt {
-- >   runEvt :: (a -> m ()) -> m ()
-- > }
--
-- So it tells us: If you give me some callback @(a -> m ())@ I will apply it to the event
-- when event will occur. But when it will occur we don't know until we run the event.
-- All events happen at the same time. Every event triggers a callback.
-- This has some special nuance to it. That can differ from other FRP libraries.
-- For example monoidal append of two event streams:
--
--  > evtA <> evtB
--
-- In many FRP libraries we choose which element will happen or should we also append the events
-- if they happen "at the same time". For this library we spawn two concurrent processes
-- on background so if two events will happen at the same time callback will be called twice.
--
-- # Dynamics
--
-- The assumption is that dynamic is a process that evolves in time.
-- And as a human beings we can only ask for current values while process happens.
-- So we assemble the dynamics with combinators an after that we can run it's process:
--
-- > ref <-runDyn dynamicValue
--
-- It produces reference to the process which we can use to sample the current value in real time:
--
-- > readDyn ref
-- >  10
-- > readDyn ref  -- 5 seconds later
-- >  10
-- > readDyn ref  -- 5 seconds later
-- >  3
--
-- This reminds us of the notion of present moment. Take for example a weather temperature.
-- We can claim to build a model of weather and have an assumption of which value will happen tomorrow
-- but the exact value for it we can only measure at the moment when it will actually happen.
--
-- So the library is based on simple assumptions:
--
-- * Event stream is a callback processor
--
-- * Event stream happen at the same time as concurrent process
--
-- * Dynamic is a process and we can only query the current value for it
--
-- * Dynamics are based on event streams. The dynamic is an observation of some underlying event streams.
--    We just remember the last event and keep producing it until the next one wil arrive.
module Dyna(
  -- * Pipe
  (|>),
  -- * Class
  Frp(..),
  -- * Events
  Evt(..),
  once,
  never,
  -- * Dynamics
  Dyn(..),
  constDyn,
  runDyn,
  DynRef(..),
  readDyn,
  cancelDyn,

  -- * Control
  newEvt,
  newDyn,
  withDyn,

  -- * API
  -- * Event API
  scan,
  scanMay,
  mapMay,
  accum,
  accumB,
  accumMay,
  filters,
  filterJust,
  whens,
  splits,
  lefts,
  rights,
  iterates,
  withIterates,

  fix1,
  fix2,
  fix3,
  fix4,
  switch,
  joins,

  delay,
  delayFork,

  sums,
  sumD,
  integrate,
  integrate2,
  products,
  count,
  withCount,
  appends,
  foldMaps,
  takes,
  drops,
  takesWhile,
  dropsWhile,
  cycles,
  listAt,
  toToggle,

  forevers,
  races,
  forks,
  -- * Render streams
  heads,
  prints,
  putStrLns,
  folds,
  foldls,
  foldls',
  foldrs,
  foldrs',
  Parser,
  runParser,
  takeP,
  cycleP,
  headP,
  maybeP,
  -- * Event/Dynamic interaction
  hold,
  unhold,
  scanD,
  scanMayD,
  switchD,
  switchDyn,
  apply,
  applyMay,
  snap,
  attach,
  attachWith,
  attachWithMay,
  (<@>),
  (<@),
  -- * Effectful API
  FunctorM(..),
  foreach,
  posteach,
  iterates',
  scan',
  scanMay',
  accum',
  accumMay',
  filters',
  mapMay',
  apply',
  applyMay',
  -- * Utilities

  -- **  Channels (interaction with the world)
  mchanEvt,
  tchanEvt,
  uchanEvt,
  UChan,
  newTriggerEvt,
  -- ** IO
  getLines,

  -- ** Clock
  clock,
  pulse,
  ticks,
  timer,
  timerD,
  -- ** Random
  toRandom,
  toRandomR,
  withRandom,
  withRandomR,
  oneOf,
  withOneOf,
  freqOf,
  withFreqOf,
  randSkip,
  randSkipBy,

  -- * Re-exports
  liftA2,
  liftA3,
  BasisArity(..),
  module X,
) where

import Prelude hiding ((<*))
import Data.IORef
import Control.Applicative (liftA2, liftA3)
import Control.Monad
import Control.Monad.IO.Class
import System.Environment
import Data.Functor
import Data.Bifunctor
import Data.Function
import Data.Maybe (fromJust)
import Data.Vector qualified as V
import Data.AdditiveGroup as X
import Data.AffineSpace as X
import Data.Basis
import Data.Cross as X
import Data.VectorSpace as X
import Data.String
import Control.Concurrent.Lifted
import Control.Concurrent.Thread.Delay qualified as D
import Control.Concurrent.Async.Lifted
import Control.Concurrent.STM
import Control.Concurrent.STM.TVar
import Control.Concurrent.STM.TChan
import Control.Concurrent.Chan.Unagi (InChan)
import Control.Concurrent.Chan.Unagi qualified as U
import Control.Concurrent.Chan qualified as M

import Control.Monad.Trans.Control
import Dyna.Ref
import Data.Time
import System.Random (Random, newStdGen, randomR, random)
import Control.Exception.Lifted
import Control.Monad.Random.Class qualified as R
import Temporal.Class as X

import Data.Boolean

infixl 4 <@>
infixl 4 <@
infixl 0  |>

{-# inline (|>) #-}
-- | Pipe operator. We often write processors of event streams
-- It makes it convenient write them from first to the last:
--
-- > evt = proc1 |> proc2 |> ... |> procN
--
-- Instead of reversed order with @($)@:
--
-- > evt = procN $ ... $ proc2 $ proc1
(|>) :: a -> (a -> b) -> b
a
a |> :: a -> (a -> b) -> b
|> a -> b
f = a -> b
f a
a


class (IsRef (Ref m), MonadBaseControl IO m, MonadIO m) => Frp m where
  type Ref m :: * -> *

instance Frp IO where
  type Ref IO = TVar

-- | Dynamics are step-wise constant effectful functions
-- each step transition is driven by underlying stream of events.
--
-- Meaning of the Dyn is a process that evolves in time.
-- We can start the process by running @runDyn@. It produces a reference to the
-- process that runs in background.
--
-- > runDyn :: Frp m => Dyn m a -> DynRef m a
--
-- When reference is initialized we can query current  value of it:
--
-- > readDyn :: DynRef m a -> m a
--
-- When we are done with observations we should shut down the background process with:
--
-- > cancelDyn :: DynRef m a -> m ()
--
-- It kills the background process and triggers the release function of underlying event stream.
data Dyn m a
  = forall s . Dyn
      { ()
dyn'get     :: s -> m a   -- ^ get the value from internal state
      , ()
dyn'evt     :: Evt m s    -- ^ stream of state updates
      , ()
dyn'init    :: m s        -- ^ initial state
      , Dyn m a -> m ()
dyn'release :: m ()       -- ^ release resources for dynamic
      }
    -- ^ event based dynamic
  | ConstDyn a
    -- ^ Constant value

-- | Reference to running dynamic process by which we can query values (@readDyn@).
-- Also note that we no longer need the reference we should release the resources
-- by calling @cancelDyn@.
data DynRef m a
  = forall s . DynRef (s -> m a) (Ref m s) ThreadId (m ())
  | ConstRef a

-- | Runs dynamic within the scope of the function.
-- It provides a callback with dyn getter as argument and after
-- callback finishes it shutdowns the dyn process.
withDyn :: Frp m => Dyn m a -> (m a -> m b) -> m b
withDyn :: Dyn m a -> (m a -> m b) -> m b
withDyn Dyn m a
dyn m a -> m b
f = m (DynRef m a)
-> (DynRef m a -> m ()) -> (DynRef m a -> m b) -> m b
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
dyn) DynRef m a -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn (\DynRef m a
ref -> m a -> m b
f (DynRef m a -> m a
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m a
ref))

-- | Dyn that is constructed from effectful callback.
constDyn :: Frp m => m a -> Dyn m a
constDyn :: m a -> Dyn m a
constDyn m a
act = (() -> m a) -> Evt m () -> m () -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (m a -> () -> m a
forall a b. a -> b -> a
const m a
act) Evt m ()
forall (m :: * -> *) a. Frp m => Evt m a
never (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

instance Functor m => Functor (Dyn m) where
  fmap :: (a -> b) -> Dyn m a -> Dyn m b
fmap a -> b
f (ConstDyn a
a)                = b -> Dyn m b
forall (m :: * -> *) a. a -> Dyn m a
ConstDyn (a -> b
f a
a)
  fmap a -> b
f (Dyn s -> m a
extract Evt m s
evt m s
s m ()
release) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn ((a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (m a -> m b) -> (s -> m a) -> s -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m a
extract) Evt m s
evt m s
s m ()
release

instance Frp m => Applicative (Dyn m) where
  pure :: a -> Dyn m a
pure a
a = a -> Dyn m a
forall (m :: * -> *) a. a -> Dyn m a
ConstDyn a
a
  (ConstDyn a -> b
f) <*> :: Dyn m (a -> b) -> Dyn m a -> Dyn m b
<*> (ConstDyn a
a) = b -> Dyn m b
forall (m :: * -> *) a. a -> Dyn m a
ConstDyn (a -> b
f a
a)
  (ConstDyn a -> b
f) <*> (Dyn s -> m a
aget Evt m s
aevt m s
as m ()
release) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (\s
s -> a -> b
f (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m a
aget s
s) Evt m s
aevt m s
as m ()
release
  (Dyn s -> m (a -> b)
fget Evt m s
fevt m s
fs m ()
release) <*> (ConstDyn a
a) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (\s
s -> ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
a) ((a -> b) -> b) -> m (a -> b) -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> s -> m (a -> b)
fget s
s) Evt m s
fevt m s
fs m ()
release
  (Dyn s -> m (a -> b)
fget Evt m s
fevt m s
fs m ()
releaseF) <*> (Dyn s -> m a
aget Evt m s
aevt m s
as m ()
releaseA) =
    ((s, s) -> m b) -> Evt m (s, s) -> m (s, s) -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (\(s
f, s
a) -> (s -> m (a -> b)
fget s
f) m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (s -> m a
aget s
a)) Evt m (s, s)
evt ((s -> s -> (s, s)) -> m s -> m s -> m (s, s)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m s
fs m s
as) (m ()
releaseF m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
releaseA)
    where
      evt :: Evt m (s, s)
evt = (((s, s) -> m ()) -> m ()) -> Evt m (s, s)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((s, s) -> m ()) -> m ()) -> Evt m (s, s))
-> (((s, s) -> m ()) -> m ()) -> Evt m (s, s)
forall a b. (a -> b) -> a -> b
$ \(s, s) -> m ()
go -> do
        Ref m (s, s)
tv <- Evt m (s, s) -> (s, s) -> m (Ref m (s, s))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m (s, s)
evt ((s, s) -> m (Ref m (s, s))) -> m (s, s) -> m (Ref m (s, s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (s -> s -> (s, s)) -> m s -> m s -> m (s, s)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m s
fs m s
as
        m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m (Either s s) -> (Either s s -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Either s s)
joint ((Either s s -> m ()) -> m ()) -> (Either s s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
          Left  s
s -> do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (s, s) -> ((s, s) -> (s, s)) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m (s, s)
tv ((s -> s) -> (s, s) -> (s, s)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((s -> s) -> (s, s) -> (s, s)) -> (s -> s) -> (s, s) -> (s, s)
forall a b. (a -> b) -> a -> b
$ s -> s -> s
forall a b. a -> b -> a
const s
s)
            (s, s) -> m ()
go ((s, s) -> m ()) -> m (s, s) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (s, s) -> m (s, s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (s, s) -> IO (s, s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (s, s)
tv)
          Right s
s -> do
            IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (s, s) -> ((s, s) -> (s, s)) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m (s, s)
tv ((s -> s) -> (s, s) -> (s, s)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((s -> s) -> (s, s) -> (s, s)) -> (s -> s) -> (s, s) -> (s, s)
forall a b. (a -> b) -> a -> b
$ s -> s -> s
forall a b. a -> b -> a
const s
s)
            (s, s) -> m ()
go ((s, s) -> m ()) -> m (s, s) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (s, s) -> m (s, s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (s, s) -> IO (s, s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (s, s)
tv)

      joint :: Evt m (Either s s)
joint = (s -> Either s s) -> Evt m s -> Evt m (Either s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Either s s
forall a b. a -> Either a b
Left Evt m s
fevt Evt m (Either s s) -> Evt m (Either s s) -> Evt m (Either s s)
forall a. Semigroup a => a -> a -> a
<> (s -> Either s s) -> Evt m s -> Evt m (Either s s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap s -> Either s s
forall a b. b -> Either a b
Right Evt m s
aevt

-- | Event stream. The meaning of an event is a callback consumer function.
-- If we give callback to it it will do something useful based on it.
--
-- The main function is runEvt:
--
-- > runEvt :: Evt m a -> (a -> m ()) -> m ()
-- > runEvt events callback = ...
--
-- Let's look at simple examples of the event streams:
--
-- Event that never produce anything:
--
-- > never = Evt {
-- >    runEvt _ = pure ()
-- >  }
--
-- So it just ignores the callback and returns right away.
--
-- Event that happens only once:
--
-- > once :: m a -> Evt m a
-- > once get = Evt {
-- >     runEvt go = go =<< get
-- >  }
--
-- It just gets the value right away and applies callback to it.
-- We can try it out in the interpreter:
--
-- > putStrLns $ fmap ("Your message: " <> ) $ once getLine
--
-- We have useful functions to print out the events: @putStrLns@ and @prints@.
--
-- Also we have event streams that happen periodically:
--
-- > prints $ clock 1  -- prints time every second
--
-- ## Duplication of the events.
--
-- Note that event streams are functions that do side-effects within some monad.
-- We use them as values but it means that two values with the same event stream definition
-- can produce different results. For example:
--
-- > a = toRandomR (0, 10) $ clock 1
-- > b = a
--
-- Note that a and b will each have their own copy of underlying random event stream.
-- So if you use it in the code don't expect values to be the same.
--
-- But if we want them to be the same we can copy event from it's definition with function:
--
-- > newEvt :: Evt m a -> m (Evt m a)
--
-- It starts the underying event stream process n background and sends all events
-- to the result by channel. With nice property of when we shut down the result event the
-- background process also shuts down.
--
-- > a <- newEvt toRandomR (0, 10) $ clock 1
-- > b = a
--
-- In this example event streams @a@ and @b@ will have the same events during execution.
newtype Evt m a = Evt { Evt m a -> (a -> m ()) -> m ()
runEvt :: (a -> m ()) -> m () }

-- | Event that happens only once and happens right away.
once :: Frp m => m a -> Evt m a
once :: m a -> Evt m a
once m a
ask = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> a -> m ()
go (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m a
ask

-- | Event that never happens. Callback function is ignored.
never :: Frp m => Evt m a
never :: Evt m a
never = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (m () -> (a -> m ()) -> m ()
forall a b. a -> b -> a
const (m () -> (a -> m ()) -> m ()) -> m () -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Runs the argument event stream as background process
-- and produces event stream that is fed with events over channel (unagi-channel package).
-- When result event stream shuts down the background process also shuts down.
newEvt :: Frp m => Evt m a -> m (Evt m a)
newEvt :: Evt m a -> m (Evt m a)
newEvt Evt m a
evt = do
  (InChan a, OutChan a)
ch <- IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InChan a, OutChan a) -> m (InChan a, OutChan a))
-> IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall a b. (a -> b) -> a -> b
$ IO (InChan a, OutChan a)
forall a. IO (InChan a, OutChan a)
U.newChan
  ThreadId
tid <- m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InChan a -> a -> IO ()
forall a. InChan a -> a -> IO ()
U.writeChan ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
ch)
  Evt m a -> m (Evt m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Evt m a -> m (Evt m a)) -> Evt m a -> m (Evt m a)
forall a b. (a -> b) -> a -> b
$ ThreadId -> m (InChan a) -> Evt m a
forall (m :: * -> *) a.
Frp m =>
ThreadId -> m (InChan a) -> Evt m a
uchanEvtFinally ThreadId
tid (InChan a -> m (InChan a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InChan a -> m (InChan a)) -> InChan a -> m (InChan a)
forall a b. (a -> b) -> a -> b
$ (InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
ch)

uchanEvtFinally :: (Frp m) => ThreadId -> m (InChan a) -> Evt m a
uchanEvtFinally :: ThreadId -> m (InChan a) -> Evt m a
uchanEvtFinally ThreadId
tid m (InChan a)
mchan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  OutChan a
chan <- IO (OutChan a) -> m (OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (OutChan a) -> m (OutChan a))
-> (InChan a -> IO (OutChan a)) -> InChan a -> m (OutChan a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InChan a -> IO (OutChan a)
forall a. InChan a -> IO (OutChan a)
U.dupChan (InChan a -> m (OutChan a)) -> m (InChan a) -> m (OutChan a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (InChan a)
mchan
  OutChan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
OutChan t -> (t -> m a) -> m b
loop OutChan a
chan a -> m ()
go m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` (ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread ThreadId
tid)
  where
    loop :: OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go = do
      t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ OutChan t -> IO t
forall a. OutChan a -> IO a
U.readChan OutChan t
chan
      t -> m a
go t
a
      OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go

-- | Runs the dynamic process in background and returns dynamic
-- that just samples the background proces with @readDyn@.
newDyn :: Frp m => Dyn m a -> m (Dyn m a)
newDyn :: Dyn m a -> m (Dyn m a)
newDyn Dyn m a
dyn = do
  DynRef m a
ref <- Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
dyn
  Dyn m a -> m (Dyn m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dyn m a -> m (Dyn m a)) -> Dyn m a -> m (Dyn m a)
forall a b. (a -> b) -> a -> b
$ (DynRef m a -> m a)
-> Evt m (DynRef m a) -> m (DynRef m a) -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn DynRef m a -> m a
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn Evt m (DynRef m a)
forall (m :: * -> *) a. Frp m => Evt m a
never (DynRef m a -> m (DynRef m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure DynRef m a
ref) (DynRef m a -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m a
ref)

instance Functor (Evt m) where
  fmap :: (a -> b) -> Evt m a -> Evt m b
fmap a -> b
f (Evt (a -> m ()) -> m ()
evt) = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
proc -> (a -> m ()) -> m ()
evt (b -> m ()
proc (b -> m ()) -> (a -> b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)

instance Frp m => Semigroup (Evt m a) where
  <> :: Evt m a -> Evt m a -> Evt m a
(<>) (Evt (a -> m ()) -> m ()
a) (Evt (a -> m ()) -> m ()
b) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
proc ->
    m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
concurrently_ ((a -> m ()) -> m ()
a a -> m ()
proc) ((a -> m ()) -> m ()
b a -> m ()
proc)

-- | Shutdown the remaining event if one of the events close up early.
races :: Frp m => Evt m a -> Evt m a -> Evt m a
races :: Evt m a -> Evt m a -> Evt m a
races (Evt (a -> m ()) -> m ()
a) (Evt (a -> m ()) -> m ()
b) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
  m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
race_ ((a -> m ()) -> m ()
a a -> m ()
go) ((a -> m ()) -> m ()
b a -> m ()
go)

-- | Execute each callback in separate thread
forks :: Frp m => Evt m a -> Evt m a
forks :: Evt m a -> Evt m a
forks Evt m a
evt =
  ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> (a -> m ThreadId) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> (a -> m ()) -> a -> m ThreadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m ()
go

instance Frp m => Monoid (Evt m a) where
  mempty :: Evt m a
mempty = Evt m a
forall (m :: * -> *) a. Frp m => Evt m a
never

instance Frp m => Applicative (Evt m) where
  pure :: a -> Evt m a
pure a
a = m a -> Evt m a
forall (m :: * -> *) a. Frp m => m a -> Evt m a
once (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
  Evt m (a -> b)
f <*> :: Evt m (a -> b) -> Evt m a -> Evt m b
<*> Evt m a
a = Evt m a
a Evt m a -> (a -> Evt m b) -> Evt m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
x -> ((a -> b) -> b) -> Evt m (a -> b) -> Evt m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) Evt m (a -> b)
f)

instance Frp m => Monad (Evt m) where
  >>= :: Evt m a -> (a -> Evt m b) -> Evt m b
(>>=) Evt m a
a a -> Evt m b
f = Evt m (Evt m b) -> Evt m b
forall (m :: * -> *) a. Frp m => Evt m (Evt m a) -> Evt m a
switch ((a -> Evt m b) -> Evt m a -> Evt m (Evt m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Evt m b
f Evt m a
a)

-- | Accumulate over event stream.
accum :: Frp m => (a -> s -> (b, s)) -> s -> Evt m a -> Evt m b
accum :: (a -> s -> (b, s)) -> s -> Evt m a -> Evt m b
accum a -> s -> (b, s)
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    (b
b, s
s) <- a -> s -> (b, s)
f a
x (s -> (b, s)) -> m s -> m (b, s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
    b -> m ()
go b
b
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s

-- | Accumulate over event stream.
accum' :: Frp m => (a -> s -> m (b, s)) -> s -> Evt m a -> Evt m b
accum' :: (a -> s -> m (b, s)) -> s -> Evt m a -> Evt m b
accum' a -> s -> m (b, s)
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    (b
b, s
s) <- a -> s -> m (b, s)
f a
x (s -> m (b, s)) -> m s -> m (b, s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
    b -> m ()
go b
b
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s

-- | Accumulate over event stream.
accumMay :: Frp m => (a -> s -> Maybe (b, s)) -> s -> Evt m a -> Evt m b
accumMay :: (a -> s -> Maybe (b, s)) -> s -> Evt m a -> Evt m b
accumMay a -> s -> Maybe (b, s)
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    Maybe (b, s)
mRes <- a -> s -> Maybe (b, s)
f a
x (s -> Maybe (b, s)) -> m s -> m (Maybe (b, s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
    Maybe (b, s) -> ((b, s) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (b, s)
mRes (((b, s) -> m ()) -> m ()) -> ((b, s) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(b
b, s
s) -> do
      b -> m ()
go b
b
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s

-- | Accumulate over event stream.
accumMay' :: Frp m => (a -> s -> m (Maybe (b, s))) -> s -> Evt m a -> Evt m b
accumMay' :: (a -> s -> m (Maybe (b, s))) -> s -> Evt m a -> Evt m b
accumMay' a -> s -> m (Maybe (b, s))
f s
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    Maybe (b, s)
mRes <- a -> s -> m (Maybe (b, s))
f a
x (s -> m (Maybe (b, s))) -> m s -> m (Maybe (b, s))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
    Maybe (b, s) -> ((b, s) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (b, s)
mRes (((b, s) -> m ()) -> m ()) -> ((b, s) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(b
b, s
s) -> do
      b -> m ()
go b
b
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s

-- | scan over event stream. Example:
--
-- > naturals = scan (+) 0 pulse
scan :: Frp m => (a -> b -> b) -> b -> Evt m a -> Evt m b
scan :: (a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> b -> b
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    b
s <- a -> b -> b
f a
x (b -> b) -> m b -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
    b -> m ()
go b
s
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s

-- | scan over event stream with effectful function.
scan' :: Frp m => (a -> b -> m b) -> b -> Evt m a -> Evt m b
scan' :: (a -> b -> m b) -> b -> Evt m a -> Evt m b
scan' a -> b -> m b
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    b
s <- a -> b -> m b
f a
x (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
    b -> m ()
go b
s
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s

-- | scan combined with filter. If accumulator function produces @Nothing@ on event then
-- that event is ignored and state is kept to previous state.
scanMay :: Frp m => (a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
scanMay :: (a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
scanMay a -> b -> Maybe b
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    Maybe b
ms <- a -> b -> Maybe b
f a
x (b -> Maybe b) -> m b -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
    Maybe b -> (b -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe b
ms ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
s -> do
      b -> m ()
go b
s
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s

-- | scan combined with filter for effectful function. See @scanMay@ for details.
scanMay' :: Frp m => (a -> b -> m (Maybe b)) -> b -> Evt m a -> Evt m b
scanMay' :: (a -> b -> m (Maybe b)) -> b -> Evt m a -> Evt m b
scanMay' a -> b -> m (Maybe b)
f b
s Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    Maybe b
ms <- a -> b -> m (Maybe b)
f a
x (b -> m (Maybe b)) -> m b -> m (Maybe b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
    Maybe b -> (b -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe b
ms ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
s -> do
      b -> m ()
go b
s
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref b
s

-- | Iterates over event stream. It's like scan but it ignores the values of underying stream
-- and starts with initial value as first element.
iterates :: Frp m => (a -> a) -> a -> Evt m b -> Evt m a
iterates :: (a -> a) -> a -> Evt m b -> Evt m a
iterates a -> a
f a
val Evt m b
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  Ref m a
ref <- Evt m b -> a -> m (Ref m a)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m b
evt a
val
  Evt m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m b
evt ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
_ -> do
    a
s <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m a -> IO a
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m a
ref)
    a -> m ()
go a
s
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m a
ref (a -> a
f a
s)

withIterates :: Frp m => (a -> a) -> a -> Evt m b -> Evt m (a, b)
withIterates :: (a -> a) -> a -> Evt m b -> Evt m (a, b)
withIterates a -> a
f a
val Evt m b
evt = (((a, b) -> m ()) -> m ()) -> Evt m (a, b)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((a, b) -> m ()) -> m ()) -> Evt m (a, b))
-> (((a, b) -> m ()) -> m ()) -> Evt m (a, b)
forall a b. (a -> b) -> a -> b
$ \(a, b) -> m ()
go -> do
  Ref m a
ref <- Evt m b -> a -> m (Ref m a)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m b
evt a
val
  Evt m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m b
evt ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
x -> do
    a
s <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m a -> IO a
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m a
ref)
    (a, b) -> m ()
go (a
s, b
x)
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m a -> a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m a
ref (a -> a
f a
s)


-- | Effectful version for @iterates@.
iterates' :: Frp m => (a -> m a) -> a -> Evt m b -> Evt m a
iterates' :: (a -> m a) -> a -> Evt m b -> Evt m a
iterates' a -> m a
f a
val Evt m b
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  Ref m a
ref <- Evt m b -> a -> m (Ref m a)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m b
evt a
val
  Evt m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m b
evt ((b -> m ()) -> m ()) -> (b -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \b
_ -> do
    a
s <- IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m a -> IO a
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m a
ref)
    a -> m ()
go a
s
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a -> a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m a
ref (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m a
f a
s

instance (Frp m, Num a) => Num (Dyn m a) where
  fromInteger :: Integer -> Dyn m a
fromInteger = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Dyn m a) -> (Integer -> a) -> Integer -> Dyn m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a. Num a => Integer -> a
fromInteger
  + :: Dyn m a -> Dyn m a -> Dyn m a
(+) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m 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
(+)
  * :: Dyn m a -> Dyn m a -> Dyn m a
(*) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m 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) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (-)
  negate :: Dyn m a -> Dyn m a
negate = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
negate
  abs :: Dyn m a -> Dyn m a
abs = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
abs
  signum :: Dyn m a -> Dyn m a
signum = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Num a => a -> a
signum

instance (Frp m, Fractional a) => Fractional (Dyn m a) where
  fromRational :: Rational -> Dyn m a
fromRational = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Dyn m a) -> (Rational -> a) -> Rational -> Dyn m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> a
forall a. Fractional a => Rational -> a
fromRational
  recip :: Dyn m a -> Dyn m a
recip = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall a. Fractional a => a -> a
recip

instance (Frp m, Semigroup a) => Semigroup (Dyn m a) where
  <> :: Dyn m a -> Dyn m a -> Dyn m a
(<>) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m 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 (Frp m, Monoid a) => Monoid (Dyn m a) where
  mempty :: Dyn m a
mempty = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty

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

-- | Reads current dynamic value.
readDyn :: Frp m => DynRef m a -> m a
readDyn :: DynRef m a -> m a
readDyn (ConstRef a
val) = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
val
readDyn (DynRef s -> m a
extract Ref m s
ref ThreadId
_ m ()
_) = do
  s
s <- IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref)
  s -> m a
extract s
s

-- | Shuts down the background process for dynamic and releases resulrces for
-- event stream that drives the dynamic.
cancelDyn :: Frp m => DynRef m a -> m ()
cancelDyn :: DynRef m a -> m ()
cancelDyn (ConstRef a
_) = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
cancelDyn (DynRef s -> m a
_ Ref m s
_ ThreadId
tid m ()
release) = ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread ThreadId
tid m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
release

-- | Executes dynamic for observation. The dynamic is step-wise constant
-- function that is driven by some event stream. The function runs the event stream
-- process in background and samples the updated state.
--
-- We can observe the value with @readDyn@. We need to shut down the stream when
-- we no longer need it with @cancelDyn@ function.
runDyn :: Frp m => Dyn m a -> m (DynRef m a)
runDyn :: Dyn m a -> m (DynRef m a)
runDyn (ConstDyn a
val) = DynRef m a -> m (DynRef m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> DynRef m a
forall (m :: * -> *) a. a -> DynRef m a
ConstRef a
val)
runDyn dyn :: Dyn m a
dyn@(Dyn s -> m a
extract Evt m s
evt m s
init m ()
release) = do
  Ref m s
ref <- Dyn m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Dyn m a -> b -> m (Ref m b)
proxyNewRefDyn Dyn m a
dyn (s -> m (Ref m s)) -> m s -> m (Ref m s)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m s
init
  ThreadId
tid <- m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m s
evt ((s -> m ()) -> m ()) -> (s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \s
s -> do
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s
  DynRef m a -> m (DynRef m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((s -> m a) -> Ref m s -> ThreadId -> m () -> DynRef m a
forall (m :: * -> *) a s.
(s -> m a) -> Ref m s -> ThreadId -> m () -> DynRef m a
DynRef s -> m a
extract Ref m s
ref ThreadId
tid m ()
release)

-- | Turns event stream to dynamic. It holds the values of
-- events until the next event happen. It starts with initial value.
--
-- > hold initVal events = ...
hold :: Frp m => a -> Evt m a -> Dyn m a
hold :: a -> Evt m a -> Dyn m a
hold a
s Evt m a
evt = (a -> m a) -> Evt m a -> m a -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Evt m a
evt (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
s) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Counts how many events accured so far on the stream.
count :: Frp m => Evt m a -> Evt m Int
count :: Evt m a -> Evt m Int
count = (a -> Int -> Int) -> Int -> Evt m a -> Evt m Int
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan ((Int -> Int) -> a -> Int -> Int
forall a b. a -> b -> a
const Int -> Int
forall a. Enum a => a -> a
succ) Int
0

withCount :: Frp m => Evt m a -> Evt m (Int, a)
withCount :: Evt m a -> Evt m (Int, a)
withCount = (a -> Int -> ((Int, a), Int)) -> Int -> Evt m a -> Evt m (Int, a)
forall (m :: * -> *) a s b.
Frp m =>
(a -> s -> (b, s)) -> s -> Evt m a -> Evt m b
accum (\a
a Int
b -> ((Int
b, a
a), Int -> Int
forall a. Enum a => a -> a
succ Int
b)) Int
1

-- | Turns dynamic into event stream of underlying events
-- that trigger dynamic updates.
unhold :: Frp m => Dyn m a -> Evt m a
unhold :: Dyn m a -> Evt m a
unhold (ConstDyn a
val) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> a -> m ()
go a
val
unhold (Dyn s -> m a
extract Evt m s
evts m s
init m ()
release) = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  a -> m ()
go (a -> m ()) -> m a -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m a
extract (s -> m a) -> m s -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m s
init
  Evt m s -> (s -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m s
evts (a -> m ()
go (a -> m ()) -> (s -> m a) -> s -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> m a
extract) m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` m ()
release

-- | scans over event stream and converts it to dynamic.
scanD :: Frp m => (a -> b -> b) -> b -> Evt m a -> Dyn m b
scanD :: (a -> b -> b) -> b -> Evt m a -> Dyn m b
scanD a -> b -> b
f b
s Evt m a
evt = b -> Evt m b -> Dyn m b
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold b
s ((a -> b -> b) -> b -> Evt m a -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> b -> b
f b
s Evt m a
evt)

-- | Accumulates the values with event stream that produce functions.
accumB :: Frp m => a -> Evt m (a -> a) -> Dyn m a
accumB :: a -> Evt m (a -> a) -> Dyn m a
accumB a
a Evt m (a -> a)
evt = ((a -> a) -> a -> a) -> a -> Evt m (a -> a) -> Dyn m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Dyn m b
scanD (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
($) a
a Evt m (a -> a)
evt

-- | Dynamic scan that can also filter out events. If Nothing is produced then the event is skipped.
scanMayD :: Frp m => (a -> b -> Maybe b) -> b -> Evt m a -> Dyn m b
scanMayD :: (a -> b -> Maybe b) -> b -> Evt m a -> Dyn m b
scanMayD a -> b -> Maybe b
f b
s Evt m a
evt = b -> Evt m b -> Dyn m b
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold b
s ((a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> Maybe b) -> b -> Evt m a -> Evt m b
scanMay a -> b -> Maybe b
f b
s Evt m a
evt)

-- | Adds some procedure to callback. Procedure is called prior to callback execution.
foreach :: Frp m => (a -> m ()) -> Evt m a -> Evt m a
foreach :: (a -> m ()) -> Evt m a -> Evt m a
foreach a -> m ()
call Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    a -> m ()
call a
x
    a -> m ()
go a
x

-- | Adds some procedure to callback. Procedure is called after callback execution.
posteach :: Frp m => (a -> m ()) -> Evt m a -> Evt m a
posteach :: (a -> m ()) -> Evt m a -> Evt m a
posteach a -> m ()
call Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    a -> m ()
go a
x
    a -> m ()
call a
x

--------------------------------------------------------------------------------
-- applications

-- | Applies a function to event stream value. The function is sampled
-- from dynamic process.
apply :: Frp m => Dyn m (a -> b) -> Evt m a -> Evt m b
apply :: Dyn m (a -> b) -> Evt m a -> Evt m b
apply Dyn m (a -> b)
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  DynRef m (a -> b)
ref <- Dyn m (a -> b) -> m (DynRef m (a -> b))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> b)
dyn
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
      b -> m ()
go (b -> m ()) -> ((a -> b) -> b) -> (a -> b) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
b) ((a -> b) -> m ()) -> m (a -> b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> b) -> m (a -> b)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> b)
ref
    )
    m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> b) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> b)
ref

-- | Effectful variant of @apply@.
apply' :: Frp m => Dyn m (a -> m b) -> Evt m a -> Evt m b
apply' :: Dyn m (a -> m b) -> Evt m a -> Evt m b
apply' Dyn m (a -> m b)
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  DynRef m (a -> m b)
ref <- Dyn m (a -> m b) -> m (DynRef m (a -> m b))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> m b)
dyn
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
    (\a -> m b
f -> b -> m ()
go (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m b
f a
b) ((a -> m b) -> m ()) -> m (a -> m b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> m b) -> m (a -> m b)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> m b)
ref)
    m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> m b) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> m b)
ref

-- | Infix variant of @apply@
(<@>) :: Frp m => Dyn m (a -> b) -> Evt m a -> Evt m b
<@> :: Dyn m (a -> b) -> Evt m a -> Evt m b
(<@>) = Dyn m (a -> b) -> Evt m a -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> b) -> Evt m a -> Evt m b
apply

-- | Infix variant of @snap@.
(<@) :: Frp m => Dyn m a -> Evt m b -> Evt m a
<@ :: Dyn m a -> Evt m b -> Evt m a
(<@) = Dyn m a -> Evt m b -> Evt m a
forall (m :: * -> *) a b. Frp m => Dyn m a -> Evt m b -> Evt m a
snap

-- | Apply combined with filter.
applyMay :: Frp m => Dyn m (a -> Maybe b) -> Evt m a -> Evt m b
applyMay :: Dyn m (a -> Maybe b) -> Evt m a -> Evt m b
applyMay Dyn m (a -> Maybe b)
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  DynRef m (a -> Maybe b)
ref <- Dyn m (a -> Maybe b) -> m (DynRef m (a -> Maybe b))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> Maybe b)
dyn
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
    (b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ())
-> ((a -> Maybe b) -> Maybe b) -> (a -> Maybe b) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> Maybe b) -> a -> Maybe b
forall a b. (a -> b) -> a -> b
$ a
b) ((a -> Maybe b) -> m ()) -> m (a -> Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> Maybe b) -> m (a -> Maybe b)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> Maybe b)
ref)
    m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> Maybe b) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> Maybe b)
ref

-- | Effectful @applyMay@.
applyMay' :: Frp m => Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' :: Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' Dyn m (a -> m (Maybe b))
dyn Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  DynRef m (a -> m (Maybe b))
ref <- Dyn m (a -> m (Maybe b)) -> m (DynRef m (a -> m (Maybe b)))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (a -> m (Maybe b))
dyn
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
b -> do
    (\a -> m (Maybe b)
f -> (b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> m (Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m (Maybe b)
f a
b) ((a -> m (Maybe b)) -> m ()) -> m (a -> m (Maybe b)) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< DynRef m (a -> m (Maybe b)) -> m (a -> m (Maybe b))
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (a -> m (Maybe b))
ref)
    m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m (a -> m (Maybe b)) -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m (a -> m (Maybe b))
ref

-- | Snapshot of dynamic process with event stream. All values
-- in the event stream are substituted with current value of dynamic.
snap :: Frp m => Dyn m a -> Evt m b -> Evt m a
snap :: Dyn m a -> Evt m b -> Evt m a
snap Dyn m a
dyn Evt m b
evt = Dyn m (b -> a) -> Evt m b -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> b) -> Evt m a -> Evt m b
apply (a -> b -> a
forall a b. a -> b -> a
const (a -> b -> a) -> Dyn m a -> Dyn m (b -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m a
dyn) Evt m b
evt

-- | Attach element from dyn to event stream.
attach :: Frp m => Dyn m a-> Evt m b -> Evt m (a, b)
attach :: Dyn m a -> Evt m b -> Evt m (a, b)
attach Dyn m a
dyn Evt m b
evt = (a -> b -> (a, b)) -> Dyn m a -> Evt m b -> Evt m (a, b)
forall (m :: * -> *) a b c.
Frp m =>
(a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith (,) Dyn m a
dyn Evt m b
evt

-- | Kind of @zipWith@ function for dynamics and event streams.
attachWith :: Frp m => (a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith :: (a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith a -> b -> c
f Dyn m a
dyn Evt m b
evt = Dyn m (b -> c) -> Evt m b -> Evt m c
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> b) -> Evt m a -> Evt m b
apply (a -> b -> c
f (a -> b -> c) -> Dyn m a -> Dyn m (b -> c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m a
dyn) Evt m b
evt

-- | Attach with filtering. When @Nothing@ is produced event is omitted from the stream.
attachWithMay :: Frp m => (a -> b -> Maybe c) -> Dyn m a -> Evt m b -> Evt m c
attachWithMay :: (a -> b -> Maybe c) -> Dyn m a -> Evt m b -> Evt m c
attachWithMay a -> b -> Maybe c
f Dyn m a
dyn Evt m b
evt = Dyn m (b -> Maybe c) -> Evt m b -> Evt m c
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> Maybe b) -> Evt m a -> Evt m b
applyMay (a -> b -> Maybe c
f (a -> b -> Maybe c) -> Dyn m a -> Dyn m (b -> Maybe c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m a
dyn) Evt m b
evt

--------------------------------------------------------------------------------
-- filters

-- | Map with filtering. When @Nothing@ is produced event is omitted from the stream.
mapMay :: Frp m => (a -> Maybe b) -> Evt m a -> Evt m b
mapMay :: (a -> Maybe b) -> Evt m a -> Evt m b
mapMay a -> Maybe b
f Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> (a -> Maybe b) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f)

-- | Effectful @mapMay@
mapMay' :: Frp m => (a -> m (Maybe b)) -> Evt m a -> Evt m b
mapMay' :: (a -> m (Maybe b)) -> Evt m a -> Evt m b
mapMay' a -> m (Maybe b)
f Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> (a -> m (Maybe b)) -> a -> m ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< a -> m (Maybe b)
f)

-- | Filtering of the event strewams. Only events that produce True remain in the stream.
filters :: Frp m => (a -> Bool) -> Evt m a -> Evt m a
filters :: (a -> Bool) -> Evt m a -> Evt m a
filters a -> Bool
f Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
x -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
f a
x) (a -> m ()
go a
x))

-- | Effectful filtering for event streams.
filters' :: Frp m => (a -> m Bool) -> Evt m a -> Evt m a
filters' :: (a -> m Bool) -> Evt m a -> Evt m a
filters' a -> m Bool
f Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (\a
x -> (\Bool
cond -> Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
cond (a -> m ()
go a
x)) (Bool -> m ()) -> m Bool -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m Bool
f a
x)

-- | Filters based on Maybe. If @Nothing@ is produced forthe event it is omitted from the stream.
filterJust :: Frp m => Evt m (Maybe a) -> Evt m a
filterJust :: Evt m (Maybe a) -> Evt m a
filterJust Evt m (Maybe a)
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> Evt m (Maybe a) -> (Maybe a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Maybe a)
evt ((a -> m ()) -> Maybe a -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> m ()
go)

-- | Filters with dynamic. When dynamic is true events pass through and when it's false
-- events are omitted.
whens :: Frp m => Dyn m Bool -> Evt m a -> Evt m a
whens :: Dyn m Bool -> Evt m a -> Evt m a
whens Dyn m Bool
dyn Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  DynRef m Bool
ref <- Dyn m Bool -> m (DynRef m Bool)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m Bool
dyn
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
b -> do
    Bool
a <- DynRef m Bool -> m Bool
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m Bool
ref
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
a (a -> m ()
go a
b)

-- | Splits the either event stream.
splits :: Frp m => Evt m (Either a b) -> (Evt m a, Evt m b)
splits :: Evt m (Either a b) -> (Evt m a, Evt m b)
splits Evt m (Either a b)
evt = (Evt m (Either a b) -> Evt m a
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m a
lefts Evt m (Either a b)
evt, Evt m (Either a b) -> Evt m b
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m b
rights Evt m (Either a b)
evt)

-- | Gets all left events from the stream
lefts :: Frp m => Evt m (Either a b) -> Evt m a
lefts :: Evt m (Either a b) -> Evt m a
lefts Evt m (Either a b)
evt = (Either a b -> Maybe a) -> Evt m (Either a b) -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((a -> Maybe a) -> (b -> Maybe a) -> Either a b -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Maybe a
forall a. a -> Maybe a
Just (Maybe a -> b -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing)) Evt m (Either a b)
evt

-- | Gets all right events from the stream
rights :: Frp m => Evt m (Either a b) -> Evt m b
rights :: Evt m (Either a b) -> Evt m b
rights Evt m (Either a b)
evt = (Either a b -> Maybe b) -> Evt m (Either a b) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((a -> Maybe b) -> (b -> Maybe b) -> Either a b -> Maybe b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe b -> a -> Maybe b
forall a b. a -> b -> a
const Maybe b
forall a. Maybe a
Nothing) b -> Maybe b
forall a. a -> Maybe a
Just) Evt m (Either a b)
evt

-- | Takes only so many events from the stream
takes :: Frp m => Int -> Evt m a -> Evt m a
takes :: Int -> Evt m a -> Evt m a
takes Int
n Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  Ref m Int
ref <- Evt m a -> Int -> m (Ref m Int)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Int
0
  m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      Int
cur <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Int -> IO Int
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m Int
ref)
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        a -> m ()
go a
x
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cur Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
        IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Int -> Int -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m Int
ref (Int
cur Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Drops first so many events from the stream
drops :: Frp m => Int -> Evt m a -> Evt m a
drops :: Int -> Evt m a -> Evt m a
drops Int
n Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  Ref m Int
tv <- Evt m a -> Int -> m (Ref m Int)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Int
n
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    Int
cur <- IO Int -> m Int
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Int -> IO Int
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m Int
tv)
    if (Int
cur Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0)
      then a -> m ()
go a
x
      else IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Int -> (Int -> Int) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m Int
tv Int -> Int
forall a. Enum a => a -> a
pred)

stopSelf :: Frp m => m ()
stopSelf :: m ()
stopSelf = ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread (ThreadId -> m ()) -> m ThreadId -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m ThreadId
forall (m :: * -> *). MonadBase IO m => m ThreadId
myThreadId

waitStop :: Frp m => Async a -> m ()
waitStop :: Async a -> m ()
waitStop Async a
x = m (Either SomeException a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either SomeException a) -> m ())
-> m (Either SomeException a) -> m ()
forall a b. (a -> b) -> a -> b
$ IO (Either SomeException a) -> m (Either SomeException a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException a) -> m (Either SomeException a))
-> IO (Either SomeException a) -> m (Either SomeException a)
forall a b. (a -> b) -> a -> b
$ Async (StM IO a) -> IO (Either SomeException a)
forall (m :: * -> *) a.
MonadBaseControl IO m =>
Async (StM m a) -> m (Either SomeException a)
waitCatch Async a
Async (StM IO a)
x

waitAsync :: Frp m => m () -> m ()
waitAsync :: m () -> m ()
waitAsync m ()
act = do
  Async (StM m ())
tid <- m () -> m (Async (StM m ()))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async m ()
act
  Async (StM m ()) -> m ()
forall (m :: * -> *) a. Frp m => Async a -> m ()
waitStop Async (StM m ())
tid

-- | Takes events only while predicate is true.
takesWhile :: Frp m => (a -> Bool) -> Evt m a -> Evt m a
takesWhile :: (a -> Bool) -> Evt m a -> Evt m a
takesWhile a -> Bool
pred Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      if (a -> Bool
pred a
x)
        then a -> m ()
go a
x
        else m ()
forall (m :: * -> *). Frp m => m ()
stopSelf

-- | Drops events while predicate is true.
dropsWhile :: Frp m => (a -> Bool) -> Evt m a -> Evt m a
dropsWhile :: (a -> Bool) -> Evt m a -> Evt m a
dropsWhile a -> Bool
pred Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  Ref m Bool
tv <- Evt m a -> Bool -> m (Ref m Bool)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Bool
True
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    Bool
cur <- IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m Bool -> IO Bool
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m Bool
tv)
    if Bool
cur
      then
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
pred a
x) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m Bool -> Bool -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m Bool
tv Bool
False
          a -> m ()
go a
x
      else a -> m ()
go a
x

-- | Takes elements from the list by index. If index is out of bounds the event is omitted.
listAt :: Frp m => [a] -> Evt m Int -> Evt m a
listAt :: [a] -> Evt m Int -> Evt m a
listAt [a]
vals Evt m Int
evt = (Int -> Maybe a) -> Evt m Int -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay (Vector a
vec Vector a -> Int -> Maybe a
forall a. Vector a -> Int -> Maybe a
V.!?) Evt m Int
evt
  where
    vec :: Vector a
vec = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
vals

-- | Turns event stream to toggle stream. It produce cyclic sequence of [True, False]
toToggle :: Frp m => Evt m a -> Evt m Bool
toToggle :: Evt m a -> Evt m Bool
toToggle = (Bool -> Bool) -> Bool -> Evt m a -> Evt m Bool
forall (m :: * -> *) a b.
Frp m =>
(a -> a) -> a -> Evt m b -> Evt m a
iterates Bool -> Bool
not Bool
True

-- | Cycles the values in the list over event sream.
cycles :: Frp m => [a] -> Evt m b -> Evt m a
cycles :: [a] -> Evt m b -> Evt m a
cycles [a]
vals Evt m b
evt = (Int -> a) -> Evt m Int -> Evt m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.!) (Evt m Int -> Evt m a) -> Evt m Int -> Evt m a
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> Int -> Evt m b -> Evt m Int
forall (m :: * -> *) a b.
Frp m =>
(a -> a) -> a -> Evt m b -> Evt m a
iterates ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
len) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Enum a => a -> a
succ) Int
0 Evt m b
evt
  where
    vec :: Vector a
vec = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
vals
    len :: Int
len = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec

-- | Sums all the elements in the event stream
sums :: (Frp m, Num a) => Evt m a -> Evt m a
sums :: Evt m a -> Evt m a
sums = (a -> a -> a) -> a -> Evt m a -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

-- | Integrates signal of vectors with given time step
integrate :: (Frp m, VectorSpace v, Real (Scalar v), Fractional (Scalar v)) => (Scalar v) -> Dyn m v -> Dyn m v
integrate :: Scalar v -> Dyn m v -> Dyn m v
integrate Scalar v
dt Dyn m v
dyn =
  v -> Evt m v -> Dyn m v
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold v
forall v. AdditiveGroup v => v
zeroV (Evt m v -> Dyn m v) -> Evt m v -> Dyn m v
forall a b. (a -> b) -> a -> b
$ (v -> v -> v) -> v -> Evt m v -> Evt m v
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
(^+^) v
forall v. AdditiveGroup v => v
zeroV ((v -> NominalDiffTime -> v)
-> Dyn m v -> Evt m NominalDiffTime -> Evt m v
forall (m :: * -> *) a b c.
Frp m =>
(a -> b -> c) -> Dyn m a -> Evt m b -> Evt m c
attachWith (\v
v NominalDiffTime
k -> NominalDiffTime -> Scalar v
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
k Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ v
v) Dyn m v
dyn (NominalDiffTime -> Evt m NominalDiffTime
forall (m :: * -> *).
Frp m =>
NominalDiffTime -> Evt m NominalDiffTime
ticks (Scalar v -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scalar v
dt)))

-- | More accurate integration of signal of vectors with given time step
integrate2 :: (Frp m, VectorSpace v, Real (Scalar v), Fractional (Scalar v)) => (Scalar v) -> Dyn m v -> Dyn m v
integrate2 :: Scalar v -> Dyn m v -> Dyn m v
integrate2 Scalar v
dt Dyn m v
dyn =
  v -> Evt m v -> Dyn m v
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold v
forall v. AdditiveGroup v => v
zeroV (Evt m v -> Dyn m v) -> Evt m v -> Dyn m v
forall a b. (a -> b) -> a -> b
$ ((Maybe (v, NominalDiffTime), v) -> v)
-> Evt m (Maybe (v, NominalDiffTime), v) -> Evt m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe (v, NominalDiffTime), v) -> v
forall a b. (a, b) -> b
snd (Evt m (Maybe (v, NominalDiffTime), v) -> Evt m v)
-> Evt m (Maybe (v, NominalDiffTime), v) -> Evt m v
forall a b. (a -> b) -> a -> b
$ ((v, NominalDiffTime)
 -> (Maybe (v, NominalDiffTime), v)
 -> (Maybe (v, NominalDiffTime), v))
-> (Maybe (v, NominalDiffTime), v)
-> Evt m (v, NominalDiffTime)
-> Evt m (Maybe (v, NominalDiffTime), v)
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan (v, NominalDiffTime)
-> (Maybe (v, NominalDiffTime), v)
-> (Maybe (v, NominalDiffTime), v)
forall v a b.
(VectorSpace v, Real a, Fractional (Scalar v)) =>
(v, a) -> (Maybe (v, b), v) -> (Maybe (v, a), v)
go (Maybe (v, NominalDiffTime)
forall a. Maybe a
Nothing, v
forall v. AdditiveGroup v => v
zeroV) (Dyn m v -> Evt m NominalDiffTime -> Evt m (v, NominalDiffTime)
forall (m :: * -> *) a b.
Frp m =>
Dyn m a -> Evt m b -> Evt m (a, b)
attach Dyn m v
dyn (NominalDiffTime -> Evt m NominalDiffTime
forall (m :: * -> *).
Frp m =>
NominalDiffTime -> Evt m NominalDiffTime
ticks (Scalar v -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Scalar v
dt)))
  where
    go :: (v, a) -> (Maybe (v, b), v) -> (Maybe (v, a), v)
go (v
v, a
h) (Maybe (v, b)
mPrev, v
res) = (((v, a) -> Maybe (v, a)
forall a. a -> Maybe a
Just (v
v, a
h), ) (v -> (Maybe (v, a), v)) -> (v -> v) -> v -> (Maybe (v, a), v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v
res v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ )) (v -> (Maybe (v, a), v)) -> v -> (Maybe (v, a), v)
forall a b. (a -> b) -> a -> b
$ case Maybe (v, b)
mPrev of
      Maybe (v, b)
Nothing       -> a -> Scalar v
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
h Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ v
v
      Just (v
v0, b
h0) -> (a -> Scalar v
forall a b. (Real a, Fractional b) => a -> b
realToFrac a
h Scalar v -> Scalar v -> Scalar v
forall a. Num a => a -> a -> a
* Scalar v
0.5) Scalar v -> v -> v
forall v. VectorSpace v => Scalar v -> v -> v
*^ (v
v0 v -> v -> v
forall v. AdditiveGroup v => v -> v -> v
^+^ v
v)

-- | Sums all points in the signal with given time step
sumD :: (Frp m, Num a) => NominalDiffTime -> Dyn m a -> Dyn m a
sumD :: NominalDiffTime -> Dyn m a -> Dyn m a
sumD NominalDiffTime
dt Dyn m a
dyn = a -> Evt m a -> Dyn m a
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold a
0 (Evt m a -> Dyn m a) -> Evt m a -> Dyn m a
forall a b. (a -> b) -> a -> b
$ Evt m a -> Evt m a
forall (m :: * -> *) a. (Frp m, Num a) => Evt m a -> Evt m a
sums (Dyn m a -> Evt m () -> Evt m a
forall (m :: * -> *) a b. Frp m => Dyn m a -> Evt m b -> Evt m a
snap Dyn m a
dyn (NominalDiffTime -> Evt m ()
forall (m :: * -> *). Frp m => NominalDiffTime -> Evt m ()
pulse NominalDiffTime
dt))


-- | Finds the product of all elements in the event stream.
products :: (Frp m, Num a) => Evt m a -> Evt m a
products :: Evt m a -> Evt m a
products = (a -> a -> a) -> a -> Evt m a -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1

-- | Monoidal append of all elements in the stream
appends :: (Frp m, Monoid a) => Evt m a -> Evt m a
appends :: Evt m a -> Evt m a
appends = (a -> a -> a) -> a -> Evt m a -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
(a -> b -> b) -> b -> Evt m a -> Evt m b
scan ((a -> a -> a) -> a -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>)) a
forall a. Monoid a => a
mempty

-- | Same as foldMap only for streams.
foldMaps :: (Frp m, Monoid b) => (a -> b) -> Evt m a -> Evt m b
foldMaps :: (a -> b) -> Evt m a -> Evt m b
foldMaps a -> b
f = Evt m b -> Evt m b
forall (m :: * -> *) a. (Frp m, Monoid a) => Evt m a -> Evt m a
appends (Evt m b -> Evt m b) -> (Evt m a -> Evt m b) -> Evt m a -> Evt m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> Evt m a -> Evt m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f

-- | Monoidal fold for event streams, note that stream have to be finite for
-- the function to complete
folds :: (Frp m, Monoid a) => Evt m a -> m a
folds :: Evt m a -> m a
folds = (a -> a -> a) -> a -> Evt m a -> m a
forall (m :: * -> *) b a.
Frp m =>
(b -> a -> b) -> b -> Evt m a -> m b
foldls a -> a -> a
forall a. Semigroup a => a -> a -> a
(<>) a
forall a. Monoid a => a
mempty

-- | Left fold for event streams, note that stream have to be finite for
-- the function to complete
foldls :: (Frp m) => (b -> a -> b) -> b -> Evt m a -> m b
foldls :: (b -> a -> b) -> b -> Evt m a -> m b
foldls b -> a -> b
f b
s Evt m a
evt = do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> (b -> b) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m b
ref ((b -> b) -> IO ()) -> (b -> b) -> IO ()
forall a b. (a -> b) -> a -> b
$ (b -> a -> b) -> a -> b -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> b
f a
x
  IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref

-- | Effectful left fold
foldls' :: (Frp m) => (b -> a -> m b) -> b -> Evt m a -> m b
foldls' :: (b -> a -> m b) -> b -> Evt m a -> m b
foldls' b -> a -> m b
f b
s Evt m a
evt = do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (b -> IO ()) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (b -> a -> m b) -> a -> b -> m b
forall a b c. (a -> b -> c) -> b -> a -> c
flip b -> a -> m b
f a
x (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
  IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref

-- | Right fold for event streams, note that stream have to be finite for
-- the function to complete
foldrs :: (Frp m) => (a -> b -> b) -> b -> Evt m a -> m b
foldrs :: (a -> b -> b) -> b -> Evt m a -> m b
foldrs a -> b -> b
f b
s Evt m a
evt = do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m b -> (b -> b) -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> (a -> a) -> IO ()
modifyRef Ref m b
ref ((b -> b) -> IO ()) -> (b -> b) -> IO ()
forall a b. (a -> b) -> a -> b
$ a -> b -> b
f a
x
  IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref

-- | Effectful right fold
foldrs' :: (Frp m) => (a -> b -> m b) -> b -> Evt m a -> m b
foldrs' :: (a -> b -> m b) -> b -> Evt m a -> m b
foldrs' a -> b -> m b
f b
s Evt m a
evt = do
  Ref m b
ref <- Evt m a -> b -> m (Ref m b)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt b
s
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (b -> IO ()) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m b -> b -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m b
ref (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> b -> m b
f a
x (b -> m b) -> m b -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref)
  IO b -> m b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> m b) -> IO b -> m b
forall a b. (a -> b) -> a -> b
$ Ref m b -> IO b
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m b
ref

-- | Starts event stream process and as callback prints it values.
prints :: (Frp m, Show a) => Evt m a -> m ()
prints :: Evt m a -> m ()
prints Evt m a
evt = Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (a -> IO ()) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO ()
forall a. Show a => a -> IO ()
print)

-- | Starts event stream process and as callback prints it values.
putStrLns :: (Frp m) => Evt m String -> m ()
putStrLns :: Evt m String -> m ()
putStrLns Evt m String
evt = Evt m String -> (String -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m String
evt (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn)

-- | Stream of user inputs
getLines :: Frp m => Evt m String
getLines :: Evt m String
getLines = m String -> Evt m String
forall (m :: * -> *) a. Frp m => m a -> Evt m a
once (IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine)

-- | Queries the event stream form dynamic and runs it all next event streams are ignored.
switchDyn :: Frp m => Dyn m (Evt m a) -> Evt m a
switchDyn :: Dyn m (Evt m a) -> Evt m a
switchDyn Dyn m (Evt m a)
dyn = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  DynRef m (Evt m a)
ref <- Dyn m (Evt m a) -> m (DynRef m (Evt m a))
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m (Evt m a)
dyn
  Evt m a
evt <- DynRef m (Evt m a) -> m (Evt m a)
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn DynRef m (Evt m a)
ref
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go

-- | Joins event stream of streams. If stream is started it runs until the end.
joins :: Frp m => Evt m (Evt m a) -> Evt m a
joins :: Evt m (Evt m a) -> Evt m a
joins Evt m (Evt m a)
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
  Evt m (Evt m a) -> (Evt m a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Evt m a)
evt ((Evt m a -> m ()) -> m ()) -> (Evt m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Evt m a
e -> m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
e a -> m ()
go

-- | Recursion on event streams. As event streams are functions we can not use
-- normal recursion that haskell provides. It will stuck the execution.
-- But we can use @fix1@ to create event stream that feeds back the events to itself.
--
-- Note that any sort of recursion can be implemented with @fix1@.
-- For example if we need 3-recursive event stream:
--
--  > fix3 ::
--  >      (Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c))
--  >   -> (Evt m a, Evt m b, Evt m c)
--
-- we can use sum tpye tags
-- to join it to single stream:
--
-- > data Tag a b c = TagA a | TagB b | TagC c
--
-- > fix3 f = unwrap $ fix1 g
-- >   where
-- >      g x = wrap <$> f (unwrapA x) (unwrapB x) (unwrapC x)
-- >
-- >      wrap a b c = mconcat [TagA <$> a, TagB <$> b, TagC <$> c]
-- >      unwrap evt = (unwrapA evt, unwrapB evt, unwrapC evt)
-- >
-- >      unwrapA = flip mapMay $ \x -> case x of
-- >                                  TagA a -> Just a
-- >                                  _      -> Nothing
--
-- We can use this trck with any number of streams. There are helper functions: @fix2@, @fix3@, @fix4@
fix1 :: Frp m => (Evt m a -> m (Evt m a)) -> Evt m a
fix1 :: (Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m a -> m (Evt m a)
f = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  (InChan a, OutChan a)
chan <- IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (InChan a, OutChan a)
forall a. IO (InChan a, OutChan a)
U.newChan
  let evt :: Evt m a
evt = InChan a -> Evt m a
forall (m :: * -> *) a. Frp m => InChan a -> Evt m a
uchanEvt ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan)
  Evt m a
evt' <- Evt m a -> m (Evt m a)
f Evt m a
evt
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt' ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ InChan a -> a -> IO ()
forall a. InChan a -> a -> IO ()
U.writeChan ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan) a
x
    a -> m ()
go a
x

-- | Recursion for binary functions
fix2 :: Frp m => (Evt m a -> Evt m b -> m (Evt m a, Evt m b)) -> (Evt m a, Evt m b)
fix2 :: (Evt m a -> Evt m b -> m (Evt m a, Evt m b)) -> (Evt m a, Evt m b)
fix2 Evt m a -> Evt m b -> m (Evt m a, Evt m b)
f = Evt m (Either a b) -> (Evt m a, Evt m b)
forall (m :: * -> *) a b.
Frp m =>
Evt m (Either a b) -> (Evt m a, Evt m b)
splits (Evt m (Either a b) -> (Evt m a, Evt m b))
-> Evt m (Either a b) -> (Evt m a, Evt m b)
forall a b. (a -> b) -> a -> b
$ (Evt m (Either a b) -> m (Evt m (Either a b)))
-> Evt m (Either a b)
forall (m :: * -> *) a.
Frp m =>
(Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m (Either a b) -> m (Evt m (Either a b))
g
  where
    g :: Evt m (Either a b) -> m (Evt m (Either a b))
g Evt m (Either a b)
x = (Evt m a, Evt m b) -> Evt m (Either a b)
forall (f :: * -> *) a b.
(Semigroup (f (Either a b)), Functor f) =>
(f a, f b) -> f (Either a b)
wrap ((Evt m a, Evt m b) -> Evt m (Either a b))
-> m (Evt m a, Evt m b) -> m (Evt m (Either a b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Evt m a -> Evt m b -> m (Evt m a, Evt m b)
f (Evt m (Either a b) -> Evt m a
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m a
lefts Evt m (Either a b)
x) (Evt m (Either a b) -> Evt m b
forall (m :: * -> *) a b. Frp m => Evt m (Either a b) -> Evt m b
rights Evt m (Either a b)
x)
    wrap :: (f a, f b) -> f (Either a b)
wrap (f a
a, f b
b) = (a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> f a -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> )f a
a f (Either a b) -> f (Either a b) -> f (Either a b)
forall a. Semigroup a => a -> a -> a
<> (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> f b -> f (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b)

data Tag3 a b c = TagA3 a | TagB3 b | TagC3 c

-- | Recursion for ternary functions
fix3 :: Frp m
  => (Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c))
  -> (Evt m a, Evt m b, Evt m c)
fix3 :: (Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c))
-> (Evt m a, Evt m b, Evt m c)
fix3 Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c)
f = Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c)
unwrap (Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c))
-> Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c)
forall a b. (a -> b) -> a -> b
$ (Evt m (Tag3 a b c) -> m (Evt m (Tag3 a b c)))
-> Evt m (Tag3 a b c)
forall (m :: * -> *) a.
Frp m =>
(Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m (Tag3 a b c) -> m (Evt m (Tag3 a b c))
g
  where
    g :: Evt m (Tag3 a b c) -> m (Evt m (Tag3 a b c))
g Evt m (Tag3 a b c)
x = (Evt m a, Evt m b, Evt m c) -> Evt m (Tag3 a b c)
forall (f :: * -> *) a b c.
(Semigroup (f (Tag3 a b c)), Functor f) =>
(f a, f b, f c) -> f (Tag3 a b c)
wrap ((Evt m a, Evt m b, Evt m c) -> Evt m (Tag3 a b c))
-> m (Evt m a, Evt m b, Evt m c) -> m (Evt m (Tag3 a b c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Evt m a -> Evt m b -> Evt m c -> m (Evt m a, Evt m b, Evt m c)
f (Evt m (Tag3 a b c) -> Evt m a
forall b b c. Evt m (Tag3 b b c) -> Evt m b
unwrapA Evt m (Tag3 a b c)
x) (Evt m (Tag3 a b c) -> Evt m b
forall a b c. Evt m (Tag3 a b c) -> Evt m b
unwrapB Evt m (Tag3 a b c)
x) (Evt m (Tag3 a b c) -> Evt m c
forall a b b. Evt m (Tag3 a b b) -> Evt m b
unwrapC Evt m (Tag3 a b c)
x)
    wrap :: (f a, f b, f c) -> f (Tag3 a b c)
wrap (f a
a, f b
b, f c
c) = (a -> Tag3 a b c
forall a b c. a -> Tag3 a b c
TagA3 (a -> Tag3 a b c) -> f a -> f (Tag3 a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a) f (Tag3 a b c) -> f (Tag3 a b c) -> f (Tag3 a b c)
forall a. Semigroup a => a -> a -> a
<> (b -> Tag3 a b c
forall a b c. b -> Tag3 a b c
TagB3 (b -> Tag3 a b c) -> f b -> f (Tag3 a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b) f (Tag3 a b c) -> f (Tag3 a b c) -> f (Tag3 a b c)
forall a. Semigroup a => a -> a -> a
<> (c -> Tag3 a b c
forall a b c. c -> Tag3 a b c
TagC3 (c -> Tag3 a b c) -> f c -> f (Tag3 a b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f c
c)

    unwrap :: Evt m (Tag3 a b c) -> (Evt m a, Evt m b, Evt m c)
unwrap Evt m (Tag3 a b c)
x = (Evt m (Tag3 a b c) -> Evt m a
forall b b c. Evt m (Tag3 b b c) -> Evt m b
unwrapA Evt m (Tag3 a b c)
x, Evt m (Tag3 a b c) -> Evt m b
forall a b c. Evt m (Tag3 a b c) -> Evt m b
unwrapB Evt m (Tag3 a b c)
x, Evt m (Tag3 a b c) -> Evt m c
forall a b b. Evt m (Tag3 a b b) -> Evt m b
unwrapC Evt m (Tag3 a b c)
x)

    unwrapA :: Evt m (Tag3 b b c) -> Evt m b
unwrapA = (Tag3 b b c -> Maybe b) -> Evt m (Tag3 b b c) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag3 b b c -> Maybe b) -> Evt m (Tag3 b b c) -> Evt m b)
-> (Tag3 b b c -> Maybe b) -> Evt m (Tag3 b b c) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
                TagA3 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
                Tag3 b b c
_       -> Maybe b
forall a. Maybe a
Nothing

    unwrapB :: Evt m (Tag3 a b c) -> Evt m b
unwrapB = (Tag3 a b c -> Maybe b) -> Evt m (Tag3 a b c) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag3 a b c -> Maybe b) -> Evt m (Tag3 a b c) -> Evt m b)
-> (Tag3 a b c -> Maybe b) -> Evt m (Tag3 a b c) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
                TagB3 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
                Tag3 a b c
_       -> Maybe b
forall a. Maybe a
Nothing

    unwrapC :: Evt m (Tag3 a b b) -> Evt m b
unwrapC = (Tag3 a b b -> Maybe b) -> Evt m (Tag3 a b b) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag3 a b b -> Maybe b) -> Evt m (Tag3 a b b) -> Evt m b)
-> (Tag3 a b b -> Maybe b) -> Evt m (Tag3 a b b) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
                TagC3 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
                Tag3 a b b
_       -> Maybe b
forall a. Maybe a
Nothing


data Tag4 a b c d = TagA4 a | TagB4 b | TagC4 c | TagD4 d

-- | Recursion for functions of four arguments
fix4 :: Frp m =>
     (Evt m a -> Evt m b -> Evt m c -> Evt m d -> m (Evt m a, Evt m b, Evt m c, Evt m d))
  -> (Evt m a, Evt m b, Evt m c, Evt m d)
fix4 :: (Evt m a
 -> Evt m b
 -> Evt m c
 -> Evt m d
 -> m (Evt m a, Evt m b, Evt m c, Evt m d))
-> (Evt m a, Evt m b, Evt m c, Evt m d)
fix4 Evt m a
-> Evt m b
-> Evt m c
-> Evt m d
-> m (Evt m a, Evt m b, Evt m c, Evt m d)
f = Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d)
unwrap (Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d))
-> Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d)
forall a b. (a -> b) -> a -> b
$ (Evt m (Tag4 a b c d) -> m (Evt m (Tag4 a b c d)))
-> Evt m (Tag4 a b c d)
forall (m :: * -> *) a.
Frp m =>
(Evt m a -> m (Evt m a)) -> Evt m a
fix1 Evt m (Tag4 a b c d) -> m (Evt m (Tag4 a b c d))
g
  where
    g :: Evt m (Tag4 a b c d) -> m (Evt m (Tag4 a b c d))
g Evt m (Tag4 a b c d)
x = (Evt m a, Evt m b, Evt m c, Evt m d) -> Evt m (Tag4 a b c d)
forall (f :: * -> *) a b c d.
(Semigroup (f (Tag4 a b c d)), Functor f) =>
(f a, f b, f c, f d) -> f (Tag4 a b c d)
wrap ((Evt m a, Evt m b, Evt m c, Evt m d) -> Evt m (Tag4 a b c d))
-> m (Evt m a, Evt m b, Evt m c, Evt m d)
-> m (Evt m (Tag4 a b c d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Evt m a
-> Evt m b
-> Evt m c
-> Evt m d
-> m (Evt m a, Evt m b, Evt m c, Evt m d)
f (Evt m (Tag4 a b c d) -> Evt m a
forall b b c d. Evt m (Tag4 b b c d) -> Evt m b
unwrapA Evt m (Tag4 a b c d)
x) (Evt m (Tag4 a b c d) -> Evt m b
forall a b c d. Evt m (Tag4 a b c d) -> Evt m b
unwrapB Evt m (Tag4 a b c d)
x) (Evt m (Tag4 a b c d) -> Evt m c
forall a b b d. Evt m (Tag4 a b b d) -> Evt m b
unwrapC Evt m (Tag4 a b c d)
x) (Evt m (Tag4 a b c d) -> Evt m d
forall a b c b. Evt m (Tag4 a b c b) -> Evt m b
unwrapD Evt m (Tag4 a b c d)
x)
    wrap :: (f a, f b, f c, f d) -> f (Tag4 a b c d)
wrap (f a
a, f b
b, f c
c, f d
d) = (a -> Tag4 a b c d
forall a b c d. a -> Tag4 a b c d
TagA4 (a -> Tag4 a b c d) -> f a -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a) f (Tag4 a b c d) -> f (Tag4 a b c d) -> f (Tag4 a b c d)
forall a. Semigroup a => a -> a -> a
<> (b -> Tag4 a b c d
forall a b c d. b -> Tag4 a b c d
TagB4 (b -> Tag4 a b c d) -> f b -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f b
b) f (Tag4 a b c d) -> f (Tag4 a b c d) -> f (Tag4 a b c d)
forall a. Semigroup a => a -> a -> a
<> (c -> Tag4 a b c d
forall a b c d. c -> Tag4 a b c d
TagC4 (c -> Tag4 a b c d) -> f c -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f c
c) f (Tag4 a b c d) -> f (Tag4 a b c d) -> f (Tag4 a b c d)
forall a. Semigroup a => a -> a -> a
<> (d -> Tag4 a b c d
forall a b c d. d -> Tag4 a b c d
TagD4 (d -> Tag4 a b c d) -> f d -> f (Tag4 a b c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f d
d)

    unwrap :: Evt m (Tag4 a b c d) -> (Evt m a, Evt m b, Evt m c, Evt m d)
unwrap Evt m (Tag4 a b c d)
x = (Evt m (Tag4 a b c d) -> Evt m a
forall b b c d. Evt m (Tag4 b b c d) -> Evt m b
unwrapA Evt m (Tag4 a b c d)
x, Evt m (Tag4 a b c d) -> Evt m b
forall a b c d. Evt m (Tag4 a b c d) -> Evt m b
unwrapB Evt m (Tag4 a b c d)
x, Evt m (Tag4 a b c d) -> Evt m c
forall a b b d. Evt m (Tag4 a b b d) -> Evt m b
unwrapC Evt m (Tag4 a b c d)
x, Evt m (Tag4 a b c d) -> Evt m d
forall a b c b. Evt m (Tag4 a b c b) -> Evt m b
unwrapD Evt m (Tag4 a b c d)
x)

    unwrapA :: Evt m (Tag4 b b c d) -> Evt m b
unwrapA = (Tag4 b b c d -> Maybe b) -> Evt m (Tag4 b b c d) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 b b c d -> Maybe b) -> Evt m (Tag4 b b c d) -> Evt m b)
-> (Tag4 b b c d -> Maybe b) -> Evt m (Tag4 b b c d) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
                TagA4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
                Tag4 b b c d
_       -> Maybe b
forall a. Maybe a
Nothing

    unwrapB :: Evt m (Tag4 a b c d) -> Evt m b
unwrapB = (Tag4 a b c d -> Maybe b) -> Evt m (Tag4 a b c d) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 a b c d -> Maybe b) -> Evt m (Tag4 a b c d) -> Evt m b)
-> (Tag4 a b c d -> Maybe b) -> Evt m (Tag4 a b c d) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
                TagB4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
                Tag4 a b c d
_       -> Maybe b
forall a. Maybe a
Nothing

    unwrapC :: Evt m (Tag4 a b b d) -> Evt m b
unwrapC = (Tag4 a b b d -> Maybe b) -> Evt m (Tag4 a b b d) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 a b b d -> Maybe b) -> Evt m (Tag4 a b b d) -> Evt m b)
-> (Tag4 a b b d -> Maybe b) -> Evt m (Tag4 a b b d) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
                TagC4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
                Tag4 a b b d
_       -> Maybe b
forall a. Maybe a
Nothing

    unwrapD :: Evt m (Tag4 a b c b) -> Evt m b
unwrapD = (Tag4 a b c b -> Maybe b) -> Evt m (Tag4 a b c b) -> Evt m b
forall (m :: * -> *) a b.
Frp m =>
(a -> Maybe b) -> Evt m a -> Evt m b
mapMay ((Tag4 a b c b -> Maybe b) -> Evt m (Tag4 a b c b) -> Evt m b)
-> (Tag4 a b c b -> Maybe b) -> Evt m (Tag4 a b c b) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \case
                TagD4 b
a -> b -> Maybe b
forall a. a -> Maybe a
Just b
a
                Tag4 a b c b
_       -> Maybe b
forall a. Maybe a
Nothing

-- | Flattens event stream producer by switching between event streams.
-- When next event stream happens it shuts down the previous one.
switch :: Frp m => Evt m (Evt m a) -> Evt m a
switch :: Evt m (Evt m a) -> Evt m a
switch Evt m (Evt m a)
evts = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  Ref m (Maybe ThreadId)
tidRef <- Evt m (Evt m a) -> Maybe ThreadId -> m (Ref m (Maybe ThreadId))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m (Evt m a)
evts Maybe ThreadId
forall a. Maybe a
Nothing
  let stop :: m ()
stop = (ThreadId -> m ()) -> Maybe ThreadId -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ThreadId -> m ()
forall (m :: * -> *). MonadBase IO m => ThreadId -> m ()
killThread (Maybe ThreadId -> m ()) -> m (Maybe ThreadId) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe ThreadId) -> m (Maybe ThreadId)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (Maybe ThreadId) -> IO (Maybe ThreadId)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (Maybe ThreadId)
tidRef)
  MVar ()
lock <- m (MVar ())
forall (m :: * -> *) a. MonadBase IO m => m (MVar a)
newEmptyMVar  -- we use this lock to make sure that next process
                        -- does not start before we saved it's threadId for stopping.
  Evt m (Evt m a) -> (Evt m a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Evt m a)
evts (\Evt m a
evt -> do
    m ()
stop
    ThreadId
tid <- m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (MVar () -> m ()
forall (m :: * -> *) a. MonadBase IO m => MVar a -> m a
takeMVar MVar ()
lock m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go)  -- delay until threadId is saved
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe ThreadId) -> Maybe ThreadId -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (Maybe ThreadId)
tidRef (ThreadId -> Maybe ThreadId
forall a. a -> Maybe a
Just ThreadId
tid)           -- save tid (for stopping)
    MVar () -> () -> m ()
forall (m :: * -> *) a. MonadBase IO m => MVar a -> a -> m ()
putMVar MVar ()
lock ()                               -- start the event process
    ) m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` m ()
stop

-- | Switches between dynamic producers.
switchD :: Frp m => Dyn m a -> Evt m (Dyn m a) -> Dyn m a
switchD :: Dyn m a -> Evt m (Dyn m a) -> Dyn m a
switchD Dyn m a
d Evt m (Dyn m a)
evts = (DynRef m a -> m a)
-> Evt m (DynRef m a) -> m (DynRef m a) -> m () -> Dyn m a
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn DynRef m a -> m a
forall a. DynRef m a -> m a
extract Evt m (DynRef m a)
resEvt m (DynRef m a)
init (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  where
    init :: m (DynRef m a)
init    = Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
d
    extract :: DynRef m a -> m a
extract = DynRef m a -> m a
forall (m :: * -> *) a. Frp m => DynRef m a -> m a
readDyn

    resEvt :: Evt m (DynRef m a)
resEvt = ((DynRef m a -> m ()) -> m ()) -> Evt m (DynRef m a)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((DynRef m a -> m ()) -> m ()) -> Evt m (DynRef m a))
-> ((DynRef m a -> m ()) -> m ()) -> Evt m (DynRef m a)
forall a b. (a -> b) -> a -> b
$ \DynRef m a -> m ()
go -> do
      Evt m (Dyn m a) -> (Dyn m a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m (Dyn m a)
evts ((Dyn m a -> m ()) -> m ()) -> (Dyn m a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Dyn m a
dyn -> do
        DynRef m a
ref <- Dyn m a -> m (DynRef m a)
forall (m :: * -> *) a. Frp m => Dyn m a -> m (DynRef m a)
runDyn Dyn m a
dyn
        DynRef m a -> m ()
go DynRef m a
ref m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`finally` DynRef m a -> m ()
forall (m :: * -> *) a. Frp m => DynRef m a -> m ()
cancelDyn DynRef m a
ref

---------------------------------------------------------
-- channels

-- | Creates the event stream that listens to MVar based channel.
-- If any value is put chan the event stream fires the callback.
mchanEvt :: (Frp m) => M.Chan a -> Evt m a
mchanEvt :: Chan a -> Evt m a
mchanEvt Chan a
chan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  Chan a
chan <- IO (Chan a) -> m (Chan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Chan a) -> m (Chan a)) -> IO (Chan a) -> m (Chan a)
forall a b. (a -> b) -> a -> b
$ Chan a -> IO (Chan a)
forall a. Chan a -> IO (Chan a)
M.dupChan Chan a
chan
  Chan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
Chan t -> (t -> m a) -> m b
loop Chan a
chan a -> m ()
go
  where
    loop :: Chan t -> (t -> m a) -> m b
loop Chan t
chan t -> m a
go = do
      t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ Chan t -> IO t
forall a. Chan a -> IO a
M.readChan Chan t
chan
      t -> m a
go t
a
      Chan t -> (t -> m a) -> m b
loop Chan t
chan t -> m a
go

-- | Creates the event stream that listens to @TChan@ based channel.
-- If any value is put chan the event stream fires the callback.
tchanEvt :: (Frp m) => TChan a -> Evt m a
tchanEvt :: TChan a -> Evt m a
tchanEvt TChan a
chan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  TChan a
chan <- IO (TChan a) -> m (TChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan a) -> m (TChan a)) -> IO (TChan a) -> m (TChan a)
forall a b. (a -> b) -> a -> b
$ STM (TChan a) -> IO (TChan a)
forall a. STM a -> IO a
atomically (STM (TChan a) -> IO (TChan a)) -> STM (TChan a) -> IO (TChan a)
forall a b. (a -> b) -> a -> b
$ TChan a -> STM (TChan a)
forall a. TChan a -> STM (TChan a)
dupTChan TChan a
chan
  TChan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
TChan t -> (t -> m a) -> m b
loop TChan a
chan a -> m ()
go
  where
    loop :: TChan t -> (t -> m a) -> m b
loop TChan t
chan t -> m a
go = do
      t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ STM t -> IO t
forall a. STM a -> IO a
atomically (STM t -> IO t) -> STM t -> IO t
forall a b. (a -> b) -> a -> b
$ TChan t -> STM t
forall a. TChan a -> STM a
readTChan TChan t
chan
      t -> m a
go t
a
      TChan t -> (t -> m a) -> m b
loop TChan t
chan t -> m a
go

-- | Creates the event stream that listens to unagi channel (package @unagi-chan@).
-- If any value is put chan the event stream fires the callback.
uchanEvt :: (Frp m) => InChan a -> Evt m a
uchanEvt :: InChan a -> Evt m a
uchanEvt InChan a
chan = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
  OutChan a
chan <- IO (OutChan a) -> m (OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (OutChan a) -> m (OutChan a))
-> IO (OutChan a) -> m (OutChan a)
forall a b. (a -> b) -> a -> b
$ InChan a -> IO (OutChan a)
forall a. InChan a -> IO (OutChan a)
U.dupChan InChan a
chan
  OutChan a -> (a -> m ()) -> m ()
forall (m :: * -> *) t a b.
MonadIO m =>
OutChan t -> (t -> m a) -> m b
loop OutChan a
chan a -> m ()
go
  where
    loop :: OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go = do
      t
a <- IO t -> m t
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO t -> m t) -> IO t -> m t
forall a b. (a -> b) -> a -> b
$ OutChan t -> IO t
forall a. OutChan a -> IO a
U.readChan OutChan t
chan
      t -> m a
go t
a
      OutChan t -> (t -> m a) -> m b
loop OutChan t
chan t -> m a
go

type UChan a = (U.InChan a, U.OutChan a)

--------------------------------------------------------------------------------

proxyNewRef :: Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef :: Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
_ b
v = IO (Ref m b) -> m (Ref m b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref m b) -> m (Ref m b)) -> IO (Ref m b) -> m (Ref m b)
forall a b. (a -> b) -> a -> b
$ b -> IO (Ref m b)
forall (ref :: * -> *) a. IsRef ref => a -> IO (ref a)
newRef b
v

proxyNewRefDyn :: Frp m => Dyn m a -> b -> m (Ref m b)
proxyNewRefDyn :: Dyn m a -> b -> m (Ref m b)
proxyNewRefDyn Dyn m a
_ b
v = IO (Ref m b) -> m (Ref m b)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Ref m b) -> m (Ref m b)) -> IO (Ref m b) -> m (Ref m b)
forall a b. (a -> b) -> a -> b
$ b -> IO (Ref m b)
forall (ref :: * -> *) a. IsRef ref => a -> IO (ref a)
newRef b
v

proxyFunRes :: (a -> b) -> b
proxyFunRes :: (a -> b) -> b
proxyFunRes a -> b
_ = b
forall a. HasCallStack => a
undefined

---------------------------------------------------------------------------
-- utilities

-- | Queries current time periodically with given period in seconds.
clock :: Frp m => NominalDiffTime -> Evt m UTCTime
clock :: NominalDiffTime -> Evt m UTCTime
clock NominalDiffTime
t = ((UTCTime -> m ()) -> m ()) -> Evt m UTCTime
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((UTCTime -> m ()) -> m ()) -> Evt m UTCTime)
-> ((UTCTime -> m ()) -> m ()) -> Evt m UTCTime
forall a b. (a -> b) -> a -> b
$ \UTCTime -> m ()
go -> NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ UTCTime -> m ()
go (UTCTime -> m ()) -> m UTCTime -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime

-- | Produces pulse events with given period in seconds.
pulse :: Frp m => NominalDiffTime -> Evt m ()
pulse :: NominalDiffTime -> Evt m ()
pulse NominalDiffTime
t = ((() -> m ()) -> m ()) -> Evt m ()
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((() -> m ()) -> m ()) -> Evt m ())
-> ((() -> m ()) -> m ()) -> Evt m ()
forall a b. (a -> b) -> a -> b
$ \() -> m ()
go -> NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (() -> m ()
go ())

-- | Produces pulse events with given period in seconds
-- and also tells how many seconds exactly has passed.
-- It can be useful for simulations of models that are based on differential equations.
-- As event streams carries how much time has passed between simulation steps.
ticks :: Frp m => NominalDiffTime -> Evt m NominalDiffTime
ticks :: NominalDiffTime -> Evt m NominalDiffTime
ticks NominalDiffTime
t = ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime)
-> ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ \NominalDiffTime -> m ()
go -> do
  IORef UTCTime
startRef <- IO (IORef UTCTime) -> m (IORef UTCTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef UTCTime) -> m (IORef UTCTime))
-> IO (IORef UTCTime) -> m (IORef UTCTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO (IORef UTCTime)
forall a. a -> IO (IORef a)
newIORef (UTCTime -> IO (IORef UTCTime)) -> IO UTCTime -> IO (IORef UTCTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
  NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    NominalDiffTime
dt <- IO NominalDiffTime -> m NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NominalDiffTime -> m NominalDiffTime)
-> IO NominalDiffTime -> m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
cur   <- IO UTCTime
getCurrentTime
      UTCTime
start <- IORef UTCTime -> IO UTCTime
forall a. IORef a -> IO a
readIORef IORef UTCTime
startRef
      IORef UTCTime -> UTCTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef UTCTime
startRef UTCTime
cur
      NominalDiffTime -> IO NominalDiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NominalDiffTime -> IO NominalDiffTime)
-> NominalDiffTime -> IO NominalDiffTime
forall a b. (a -> b) -> a -> b
$ UTCTime
cur UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
start
    NominalDiffTime -> m ()
go NominalDiffTime
dt

-- | Timer behaves like tocks only it produces accumulated time since beginning
-- of the process. It calculates them by querying current time and suntracting start time from it.
--
-- It can be though of as:
--
-- > sums ticks
timer :: Frp m => NominalDiffTime -> Evt m NominalDiffTime
timer :: NominalDiffTime -> Evt m NominalDiffTime
timer NominalDiffTime
t = ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime)
-> ((NominalDiffTime -> m ()) -> m ()) -> Evt m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ \NominalDiffTime -> m ()
go -> do
  UTCTime
start <- IO UTCTime -> m UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  NominalDiffTime -> m () -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
t (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> m ()
go (NominalDiffTime -> m ()) -> m NominalDiffTime -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO NominalDiffTime -> m NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
start) (UTCTime -> NominalDiffTime) -> IO UTCTime -> IO NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime)

-- | Timer as dynamic signal.
timerD :: Frp m => NominalDiffTime -> Dyn m NominalDiffTime
timerD :: NominalDiffTime -> Dyn m NominalDiffTime
timerD NominalDiffTime
t = NominalDiffTime -> Evt m NominalDiffTime -> Dyn m NominalDiffTime
forall (m :: * -> *) a. Frp m => a -> Evt m a -> Dyn m a
hold NominalDiffTime
0 (Evt m NominalDiffTime -> Dyn m NominalDiffTime)
-> Evt m NominalDiffTime -> Dyn m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Evt m NominalDiffTime
forall (m :: * -> *).
Frp m =>
NominalDiffTime -> Evt m NominalDiffTime
timer NominalDiffTime
t

{-# NOINLINE periodic #-}
-- | Periodically triggers callback.
periodic :: MonadIO m => NominalDiffTime -> m () -> m ()
periodic :: NominalDiffTime -> m () -> m ()
periodic NominalDiffTime
dur m ()
proc = do
  IORef UTCTime
startRef <- IO (IORef UTCTime) -> m (IORef UTCTime)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef UTCTime) -> m (IORef UTCTime))
-> IO (IORef UTCTime) -> m (IORef UTCTime)
forall a b. (a -> b) -> a -> b
$ UTCTime -> IO (IORef UTCTime)
forall a. a -> IO (IORef a)
newIORef (UTCTime -> IO (IORef UTCTime)) -> IO UTCTime -> IO (IORef UTCTime)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime
  (m () -> m ()) -> m ()
forall a. (a -> a) -> a
fix ((m () -> m ()) -> m ()) -> (m () -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \m ()
next -> do
    m ()
proc
    NominalDiffTime
time <- IO NominalDiffTime -> m NominalDiffTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO NominalDiffTime -> m NominalDiffTime)
-> IO NominalDiffTime -> m NominalDiffTime
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
last <- IORef UTCTime -> IO UTCTime
forall a. IORef a -> IO a
readIORef IORef UTCTime
startRef
      UTCTime
cur  <- IO UTCTime
getCurrentTime
      let dt :: NominalDiffTime
dt = NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Ord a => a -> a -> a
max NominalDiffTime
0 (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime
dur NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- (UTCTime
cur UTCTime -> UTCTime -> NominalDiffTime
`diffUTCTime` UTCTime
last)
      IORef UTCTime -> UTCTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef UTCTime
startRef (NominalDiffTime -> UTCTime -> UTCTime
addUTCTime NominalDiffTime
dt UTCTime
cur)
      NominalDiffTime -> IO NominalDiffTime
forall (f :: * -> *) a. Applicative f => a -> f a
pure NominalDiffTime
dt
    NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep NominalDiffTime
time
    m ()
next

-- | Stop the thread for some time in seconds.
sleep :: MonadIO m => NominalDiffTime -> m ()
sleep :: NominalDiffTime -> m ()
sleep NominalDiffTime
dt = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Integer -> IO ()) -> Integer -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> IO ()
D.delay (Integer -> m ()) -> Integer -> m ()
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Integer
toMicroseconds NominalDiffTime
dt

-- | Convert time to microseconds
toMicroseconds :: NominalDiffTime -> Integer
toMicroseconds :: NominalDiffTime -> Integer
toMicroseconds NominalDiffTime
t = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational NominalDiffTime
t Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
1000000

--------------------------------------------------------------------------------

-- | Substitutes values in event stream with random values.
toRandom :: forall m a b . (Frp m, Random b) => Evt m a -> Evt m b
toRandom :: Evt m a -> Evt m b
toRandom Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
    (b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
    b -> m ()
go b
a
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g

-- | Substitutes values in event stream with random values from the given range.
toRandomR :: forall m a b . (Frp m, Random b) => (b, b) -> Evt m a -> Evt m b
toRandomR :: (b, b) -> Evt m a -> Evt m b
toRandomR (b, b)
range Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
_ -> do
    (b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ (b, b) -> StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (b, b)
range (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
    b -> m ()
go b
a
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g

-- | Substitutes values in event stream with random values.
withRandom :: forall m a b . (Frp m, Random b) => Evt m a -> Evt m (b, a)
withRandom :: Evt m a -> Evt m (b, a)
withRandom Evt m a
evt = (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((b, a) -> m ()) -> m ()) -> Evt m (b, a))
-> (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall a b. (a -> b) -> a -> b
$ \(b, a) -> m ()
go -> do
  Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    (b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => g -> (a, g)
random (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
    (b, a) -> m ()
go (b
a, a
x)
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g

-- | Substitutes values in event stream with random values from the given range.
withRandomR :: forall m a b . (Frp m, Random b) => (b, b) -> Evt m a -> Evt m (b, a)
withRandomR :: (b, b) -> Evt m a -> Evt m (b, a)
withRandomR (b, b)
range Evt m a
evt = (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt ((((b, a) -> m ()) -> m ()) -> Evt m (b, a))
-> (((b, a) -> m ()) -> m ()) -> Evt m (b, a)
forall a b. (a -> b) -> a -> b
$ \(b, a) -> m ()
go -> do
  Ref m StdGen
tv <- Evt m a -> StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (StdGen -> m (Ref m StdGen)) -> m StdGen -> m (Ref m StdGen)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO StdGen -> m StdGen
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
newStdGen
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
    (b
a, StdGen
g) <- IO (b, StdGen) -> m (b, StdGen)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (b, StdGen) -> m (b, StdGen))
-> IO (b, StdGen) -> m (b, StdGen)
forall a b. (a -> b) -> a -> b
$ (b, b) -> StdGen -> (b, StdGen)
forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (b, b)
range (StdGen -> (b, StdGen)) -> IO StdGen -> IO (b, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ref m StdGen -> IO StdGen
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m StdGen
tv
    (b, a) -> m ()
go (b
a, a
x)
    IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m StdGen -> StdGen -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m StdGen
tv StdGen
g

-- | Picks at random one element from the list
oneOf :: Frp m => [a] -> Evt m b -> Evt m a
oneOf :: [a] -> Evt m b -> Evt m a
oneOf [a]
xs Evt m b
evt = [a] -> Evt m Int -> Evt m a
forall (m :: * -> *) a. Frp m => [a] -> Evt m Int -> Evt m a
listAt [a]
xs (Evt m Int -> Evt m a) -> Evt m Int -> Evt m a
forall a b. (a -> b) -> a -> b
$ (Int, Int) -> Evt m b -> Evt m Int
forall (m :: * -> *) a b.
(Frp m, Random b) =>
(b, b) -> Evt m a -> Evt m b
toRandomR (Int
0, Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Evt m b
evt
  where
    len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs

-- | Picks at random one element from the list
withOneOf :: Frp m => [a] -> Evt m b -> Evt m (a, b)
withOneOf :: [a] -> Evt m b -> Evt m (a, b)
withOneOf [a]
xs Evt m b
evt = (Int -> a) -> (Int, b) -> (a, b)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Vector a
vec Vector a -> Int -> a
forall a. Vector a -> Int -> a
V.! ) ((Int, b) -> (a, b)) -> Evt m (Int, b) -> Evt m (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Evt m b -> Evt m (Int, b)
forall (m :: * -> *) a b.
(Frp m, Random b) =>
(b, b) -> Evt m a -> Evt m (b, a)
withRandomR (Int
0, Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Evt m b
evt
  where
    len :: Int
len = Vector a -> Int
forall a. Vector a -> Int
V.length Vector a
vec
    vec :: Vector a
vec = [a] -> Vector a
forall a. [a] -> Vector a
V.fromList [a]
xs

-- | Picks at random one element from the list. We also provide distribution of events.
-- Probability to pick up the element. Sum of probabilities should equal to 1.
freqOf :: (R.MonadRandom m, Frp m) => Dyn m [(a, Rational)] -> Evt m b -> Evt m a
freqOf :: Dyn m [(a, Rational)] -> Evt m b -> Evt m a
freqOf Dyn m [(a, Rational)]
dynVals Evt m b
evts = Dyn m (b -> m (Maybe a)) -> Evt m b -> Evt m a
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' ((\[(a, Rational)]
vals -> m (Maybe a) -> b -> m (Maybe a)
forall a b. a -> b -> a
const ([(a, Rational)] -> m (Maybe a)
forall (m :: * -> *) a.
MonadRandom m =>
[(a, Rational)] -> m (Maybe a)
go [(a, Rational)]
vals)) ([(a, Rational)] -> b -> m (Maybe a))
-> Dyn m [(a, Rational)] -> Dyn m (b -> m (Maybe a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m [(a, Rational)]
dynVals) Evt m b
evts
  where
    go :: [(a, Rational)] -> m (Maybe a)
go [(a, Rational)]
vals = [(a, Rational)] -> m (Maybe a)
forall (m :: * -> *) a.
MonadRandom m =>
[(a, Rational)] -> m (Maybe a)
R.fromListMay [(a, Rational)]
vals

-- | Picks at random one element from the list. We also provide distribution of events.
-- Probability to pick up the element. Sum of probabilities should equal to 1.
withFreqOf :: (R.MonadRandom m, Frp m) => Dyn m [(a, Rational)] -> Evt m b -> Evt m (a, b)
withFreqOf :: Dyn m [(a, Rational)] -> Evt m b -> Evt m (a, b)
withFreqOf Dyn m [(a, Rational)]
dynVals Evt m b
evts = Dyn m (b -> m (Maybe (a, b))) -> Evt m b -> Evt m (a, b)
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a -> m (Maybe b)) -> Evt m a -> Evt m b
applyMay' ([(a, Rational)] -> b -> m (Maybe (a, b))
forall (f :: * -> *) t t.
MonadRandom f =>
[(t, Rational)] -> t -> f (Maybe (t, t))
go ([(a, Rational)] -> b -> m (Maybe (a, b)))
-> Dyn m [(a, Rational)] -> Dyn m (b -> m (Maybe (a, b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m [(a, Rational)]
dynVals) Evt m b
evts
  where
    go :: [(t, Rational)] -> t -> f (Maybe (t, t))
go [(t, Rational)]
vals t
x = (Maybe t -> Maybe (t, t)) -> f (Maybe t) -> f (Maybe (t, t))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t -> (t, t)) -> Maybe t -> Maybe (t, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((, t
x))) (f (Maybe t) -> f (Maybe (t, t)))
-> f (Maybe t) -> f (Maybe (t, t))
forall a b. (a -> b) -> a -> b
$ [(t, Rational)] -> f (Maybe t)
forall (m :: * -> *) a.
MonadRandom m =>
[(a, Rational)] -> m (Maybe a)
R.fromListMay [(t, Rational)]
vals

-- | Skips at random elements from the list. We provide frequency to skip events with dynamic first argument.
randSkip :: Frp m => Dyn m Double -> Evt m a -> Evt m a
randSkip :: Dyn m Double -> Evt m a -> Evt m a
randSkip Dyn m Double
prob Evt m a
evt = Dyn m (a -> Double) -> Evt m a -> Evt m a
forall (m :: * -> *) a.
Frp m =>
Dyn m (a -> Double) -> Evt m a -> Evt m a
randSkipBy (Double -> a -> Double
forall a b. a -> b -> a
const (Double -> a -> Double) -> Dyn m Double -> Dyn m (a -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dyn m Double
prob) Evt m a
evt

-- | Skips elements at random. The probability to skip element depends on the element itself.
randSkipBy :: Frp m => Dyn m (a -> Double) -> Evt m a -> Evt m a
randSkipBy :: Dyn m (a -> Double) -> Evt m a -> Evt m a
randSkipBy  Dyn m (a -> Double)
prob Evt m a
evt = ((a -> Double) -> (Double, a) -> Maybe a)
-> Dyn m (a -> Double) -> Evt m (Double, a) -> Evt m a
forall (m :: * -> *) a b c.
Frp m =>
(a -> b -> Maybe c) -> Dyn m a -> Evt m b -> Evt m c
attachWithMay (a -> Double) -> (Double, a) -> Maybe a
forall a a. Ord a => (a -> a) -> (a, a) -> Maybe a
f Dyn m (a -> Double)
prob (Evt m (Double, a) -> Evt m a) -> Evt m (Double, a) -> Evt m a
forall a b. (a -> b) -> a -> b
$ (Double, Double) -> Evt m a -> Evt m (Double, a)
forall (m :: * -> *) a b.
(Frp m, Random b) =>
(b, b) -> Evt m a -> Evt m (b, a)
withRandomR (Double
0, Double
1 :: Double) Evt m a
evt
  where
    f :: (a -> a) -> (a, a) -> Maybe a
f a -> a
getProb (a
curProb, a
a)
      | a
curProb a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a -> a
getProb a
a  = Maybe a
forall a. Maybe a
Nothing
      | Bool
otherwise            = a -> Maybe a
forall a. a -> Maybe a
Just a
a

--------------------------------------------------------------------------------

-- | Delays in the thread of execution. Note that it can interfere
-- and screw up functions like clock, timer, pulse, ticks
delay :: Frp m => NominalDiffTime -> Evt m a -> Evt m a
delay :: NominalDiffTime -> Evt m a -> Evt m a
delay NominalDiffTime
dt Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep NominalDiffTime
dt m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
go a
x

-- | Delays in background by forking on each event.
-- Note tht if delayed event was put into background prior
-- to stopping of the main event stream it will fire anyway.
-- There is no way to stop it.
delayFork :: Frp m => NominalDiffTime -> Evt m a -> Evt m a
delayFork :: NominalDiffTime -> Evt m a -> Evt m a
delayFork NominalDiffTime
dt Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
  Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep NominalDiffTime
dt m () -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> m ()
go a
x

--------------------------------------------------------------------------------
-- effectful functor

class FunctorM f where
  fmap' :: Frp m => (a -> m b) -> f m a -> f m b

instance FunctorM Evt where
  fmap' :: (a -> m b) -> Evt m a -> Evt m b
fmap' a -> m b
f Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> b -> m ()
go (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m b
f a
x

instance FunctorM Dyn where
  fmap' :: (a -> m b) -> Dyn m a -> Dyn m b
fmap' a -> m b
f (ConstDyn a
a)                = (a -> m b) -> Evt m a -> m a -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn a -> m b
f Evt m a
forall (m :: * -> *) a. Frp m => Evt m a
never (a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a) (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
  fmap' a -> m b
f (Dyn s -> m a
extract Evt m s
evt m s
s m ()
release) = (s -> m b) -> Evt m s -> m s -> m () -> Dyn m b
forall (m :: * -> *) a s.
(s -> m a) -> Evt m s -> m s -> m () -> Dyn m a
Dyn (a -> m b
f (a -> m b) -> (s -> m a) -> s -> m b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< s -> m a
extract) Evt m s
evt m s
s m ()
release

--------------------------------------------------------------------------------
-- Boolean instances

instance (Boolean b, Frp m) => Boolean (Dyn m b) where
  true :: Dyn m b
true = b -> Dyn m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall b. Boolean b => b
true
  false :: Dyn m b
false = b -> Dyn m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
forall b. Boolean b => b
false
  notB :: Dyn m b -> Dyn m b
notB = (b -> b) -> Dyn m b -> Dyn m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> b
forall b. Boolean b => b -> b
notB
  &&* :: Dyn m b -> Dyn m b -> Dyn m b
(&&*) = (b -> b -> b) -> Dyn m b -> Dyn m b -> Dyn m b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall b. Boolean b => b -> b -> b
(&&*)
  ||* :: Dyn m b -> Dyn m b -> Dyn m b
(||*) = (b -> b -> b) -> Dyn m b -> Dyn m b -> Dyn m b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 b -> b -> b
forall b. Boolean b => b -> b -> b
(||*)

type instance BooleanOf (Dyn m a) = Dyn m (BooleanOf a)

instance (Frp m, IfB a) => IfB (Dyn m a) where
  ifB :: bool -> Dyn m a -> Dyn m a -> Dyn m a
ifB = (BooleanOf a -> a -> a -> a)
-> Dyn m (BooleanOf a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c d.
Applicative f =>
(a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 BooleanOf a -> a -> a -> a
forall a bool. (IfB a, bool ~ BooleanOf a) => bool -> a -> a -> a
ifB

instance (EqB a, Frp m) => EqB (Dyn m a) where
  ==* :: Dyn m a -> Dyn m a -> bool
(==*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (EqB a, bool ~ BooleanOf a) => a -> a -> bool
(==*)

instance (OrdB a, Frp m) => OrdB (Dyn m a) where
  <* :: Dyn m a -> Dyn m a -> bool
(<*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(<*)
  >* :: Dyn m a -> Dyn m a -> bool
(>*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(>*)
  <=* :: Dyn m a -> Dyn m a -> bool
(<=*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(<=*)
  >=* :: Dyn m a -> Dyn m a -> bool
(>=*) = (a -> a -> BooleanOf a)
-> Dyn m a -> Dyn m a -> Dyn m (BooleanOf a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> BooleanOf a
forall a bool. (OrdB a, bool ~ BooleanOf a) => a -> a -> bool
(>=*)

--------------------------------------------------------------------------------
-- Vector Space instances

instance (AdditiveGroup a, Frp m) => AdditiveGroup (Dyn m a) where
  zeroV :: Dyn m a
zeroV = a -> Dyn m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall v. AdditiveGroup v => v
zeroV
  ^+^ :: Dyn m a -> Dyn m a -> Dyn m a
(^+^) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall v. AdditiveGroup v => v -> v -> v
(^+^)
  ^-^ :: Dyn m a -> Dyn m a -> Dyn m a
(^-^) = (a -> a -> a) -> Dyn m a -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall v. AdditiveGroup v => v -> v -> v
(^-^)
  negateV :: Dyn m a -> Dyn m a
negateV = (a -> a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> a
forall v. AdditiveGroup v => v -> v
negateV

instance (VectorSpace a, Frp m) => VectorSpace (Dyn m a) where
  type Scalar (Dyn m a) = Dyn m (Scalar a)
  *^ :: Scalar (Dyn m a) -> Dyn m a -> Dyn m a
(*^) = (Scalar a -> a -> a) -> Dyn m (Scalar a) -> Dyn m a -> Dyn m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Scalar a -> a -> a
forall v. VectorSpace v => Scalar v -> v -> v
(*^)

instance (AffineSpace p, Frp m) => AffineSpace (Dyn m p) where
  type Diff (Dyn m p) = Dyn m (Diff p)
  .-. :: Dyn m p -> Dyn m p -> Diff (Dyn m p)
(.-.) = (p -> p -> Diff p) -> Dyn m p -> Dyn m p -> Dyn m (Diff p)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p -> p -> Diff p
forall p. AffineSpace p => p -> p -> Diff p
(.-.)
  .+^ :: Dyn m p -> Diff (Dyn m p) -> Dyn m p
(.+^) = (p -> Diff p -> p) -> Dyn m p -> Dyn m (Diff p) -> Dyn m p
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p -> Diff p -> p
forall p. AffineSpace p => p -> Diff p -> p
(.+^)

class BasisArity v where
  basisArity :: v -> Int

instance BasisArity Float where
  basisArity :: Float -> Int
basisArity Float
_ = Int
1

instance BasisArity Double where
  basisArity :: Double -> Int
basisArity Double
_ = Int
1

instance (BasisArity a, BasisArity b) =>  BasisArity (a, b) where
  basisArity :: (a, b) -> Int
basisArity (a, b)
v = a -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b) -> a
forall a b. (a, b) -> a
proxyA (a, b)
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b) -> b
forall a b. (a, b) -> b
proxyB (a, b)
v)
    where
      proxyA :: (a, b) -> a
      proxyA :: (a, b) -> a
proxyA (a, b)
_ = a
forall a. HasCallStack => a
undefined

      proxyB :: (a, b) -> b
      proxyB :: (a, b) -> b
proxyB (a, b)
_ = b
forall a. HasCallStack => a
undefined

instance (BasisArity a, BasisArity b, BasisArity c) =>  BasisArity (a, b, c) where
  basisArity :: (a, b, c) -> Int
basisArity (a, b, c)
v = a -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b, c) -> a
forall a b c. (a, b, c) -> a
proxyA (a, b, c)
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ b -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b, c) -> b
forall a b c. (a, b, c) -> b
proxyB (a, b, c)
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ c -> Int
forall v. BasisArity v => v -> Int
basisArity ((a, b, c) -> c
forall a b c. (a, b, c) -> c
proxyC (a, b, c)
v)
    where
      proxyA :: (a, b, c) -> a
      proxyA :: (a, b, c) -> a
proxyA (a, b, c)
_ = a
forall a. HasCallStack => a
undefined

      proxyB :: (a, b, c) -> b
      proxyB :: (a, b, c) -> b
proxyB (a, b, c)
_ = b
forall a. HasCallStack => a
undefined

      proxyC :: (a, b, c) -> c
      proxyC :: (a, b, c) -> c
proxyC (a, b, c)
_ = c
forall a. HasCallStack => a
undefined

instance (Frp m, BasisArity v) => BasisArity (Dyn m v) where
  basisArity :: Dyn m v -> Int
basisArity Dyn m v
v = v -> Int
forall v. BasisArity v => v -> Int
basisArity (Dyn m v -> v
forall (m :: * -> *) v. Dyn m v -> v
proxy Dyn m v
v)
    where
      proxy :: Dyn m v -> v
      proxy :: Dyn m v -> v
proxy Dyn m v
_ = v
forall a. HasCallStack => a
undefined

instance (BasisArity v, HasBasis v, Frp m) => HasBasis (Dyn m v) where
  type Basis (Dyn m v) = Dyn m (Basis v)
  basisValue :: Basis (Dyn m v) -> Dyn m v
basisValue = (Basis v -> v) -> Dyn m (Basis v) -> Dyn m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Basis v -> v
forall v. HasBasis v => Basis v -> v
basisValue
  decompose :: Dyn m v -> [(Basis (Dyn m v), Scalar (Dyn m v))]
decompose Dyn m v
v = (Dyn m (Basis v, Scalar v) -> (Dyn m (Basis v), Dyn m (Scalar v)))
-> [Dyn m (Basis v, Scalar v)]
-> [(Dyn m (Basis v), Dyn m (Scalar v))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dyn m (Basis v, Scalar v) -> (Dyn m (Basis v), Dyn m (Scalar v))
forall (m :: * -> *) a b.
Frp m =>
Dyn m (a, b) -> (Dyn m a, Dyn m b)
unTupleD ([Dyn m (Basis v, Scalar v)]
 -> [(Dyn m (Basis v), Dyn m (Scalar v))])
-> [Dyn m (Basis v, Scalar v)]
-> [(Dyn m (Basis v), Dyn m (Scalar v))]
forall a b. (a -> b) -> a -> b
$ Int -> Dyn m [(Basis v, Scalar v)] -> [Dyn m (Basis v, Scalar v)]
forall (m :: * -> *) a. Frp m => Int -> Dyn m [a] -> [Dyn m a]
unListD (Dyn m v -> Int
forall v. BasisArity v => v -> Int
basisArity Dyn m v
v) (Dyn m [(Basis v, Scalar v)] -> [Dyn m (Basis v, Scalar v)])
-> Dyn m [(Basis v, Scalar v)] -> [Dyn m (Basis v, Scalar v)]
forall a b. (a -> b) -> a -> b
$ (v -> [(Basis v, Scalar v)])
-> Dyn m v -> Dyn m [(Basis v, Scalar v)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> [(Basis v, Scalar v)]
forall v. HasBasis v => v -> [(Basis v, Scalar v)]
decompose Dyn m v
v

  decompose' :: Dyn m v -> Basis (Dyn m v) -> Scalar (Dyn m v)
decompose' = (v -> Basis v -> Scalar v)
-> Dyn m v -> Dyn m (Basis v) -> Dyn m (Scalar v)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> Basis v -> Scalar v
forall v. HasBasis v => v -> Basis v -> Scalar v
decompose'

unTupleD :: Frp m => Dyn m (a, b) -> (Dyn m a, Dyn m b)
unTupleD :: Dyn m (a, b) -> (Dyn m a, Dyn m b)
unTupleD Dyn m (a, b)
x = (((a, b) -> a) -> Dyn m (a, b) -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst Dyn m (a, b)
x, ((a, b) -> b) -> Dyn m (a, b) -> Dyn m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd Dyn m (a, b)
x)

unListD :: Frp m => Int -> Dyn m [a] -> [Dyn m a]
unListD :: Int -> Dyn m [a] -> [Dyn m a]
unListD Int
n Dyn m [a]
ds = (Int -> Dyn m a) -> [Int] -> [Dyn m a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
a -> ([a] -> a) -> Dyn m [a] -> Dyn m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ( [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
a) Dyn m [a]
ds) [Int
0.. Int -> Int
forall a. Enum a => a -> a
pred Int
n]

instance (HasNormal v, Frp m) => HasNormal (Dyn m v) where
  normalVec :: Dyn m v -> Dyn m v
normalVec = (v -> v) -> Dyn m v -> Dyn m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall v. HasNormal v => v -> v
normalVec

instance (HasCross2 v, Frp m) => HasCross2 (Dyn m v) where
  cross2 :: Dyn m v -> Dyn m v
cross2 = (v -> v) -> Dyn m v -> Dyn m v
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> v
forall v. HasCross2 v => v -> v
cross2

instance (HasCross3 v, Frp m) => HasCross3 (Dyn m v) where
  cross3 :: Dyn m v -> Dyn m v -> Dyn m v
cross3 = (v -> v -> v) -> Dyn m v -> Dyn m v -> Dyn m v
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 v -> v -> v
forall v. HasCross3 v => v -> v -> v
cross3

--------------------------------------------------------------------------------
-- Temporal media instances

instance Frp m => Melody (Evt m a) where
  +:+ :: Evt m a -> Evt m a -> Evt m a
(+:+) Evt m a
evtA Evt m a
evtB = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> do
      Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evtA a -> m ()
go
      Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evtB a -> m ()
go

instance Frp m => Harmony (Evt m a) where
  =:= :: Evt m a -> Evt m a -> Evt m a
(=:=) = Evt m a -> Evt m a -> Evt m a
forall a. Semigroup a => a -> a -> a
(<>)

instance Frp m => Compose (Evt m a) where

instance Frp m => Loop (Evt m a) where
  loop :: Evt m a -> Evt m a
loop Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go)

-- | Takes an event and repeats it all the time.
forevers :: Frp m => Evt m a -> Evt m a
forevers :: Evt m a -> Evt m a
forevers Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go -> m () -> m ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go)

type instance DurOf (Evt m a) = NominalDiffTime

instance Frp m => Limit (Evt m a) where
  lim :: DurOf (Evt m a) -> Evt m a -> Evt m a
lim DurOf (Evt m a)
t Evt m a
evt = ((a -> m ()) -> m ()) -> Evt m a
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((a -> m ()) -> m ()) -> Evt m a)
-> ((a -> m ()) -> m ()) -> Evt m a
forall a b. (a -> b) -> a -> b
$ \a -> m ()
go ->
    m () -> m () -> m ()
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m ()
race_ (Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt a -> m ()
go) (NominalDiffTime -> m ()
forall (m :: * -> *). MonadIO m => NominalDiffTime -> m ()
sleep DurOf (Evt m a)
NominalDiffTime
t)

--------------------------------------------------------------------------------
-- Parser

data St a = Final a | Cont a
  deriving (a -> St b -> St a
(a -> b) -> St a -> St b
(forall a b. (a -> b) -> St a -> St b)
-> (forall a b. a -> St b -> St a) -> Functor St
forall a b. a -> St b -> St a
forall a b. (a -> b) -> St a -> St b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> St b -> St a
$c<$ :: forall a b. a -> St b -> St a
fmap :: (a -> b) -> St a -> St b
$cfmap :: forall a b. (a -> b) -> St a -> St b
Functor)

data Parser m a b = forall s . Parser
  { ()
parser'init   :: s
  , ()
parser'modify :: (a -> s -> m (Maybe (St s)))
  , ()
parser'get    :: s -> m (Maybe b)
  }

runParser :: Frp m => Parser m a b -> Evt m a -> m (Maybe b)
runParser :: Parser m a b -> Evt m a -> m (Maybe b)
runParser (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe b)
get) Evt m a
evt = do
  Ref m (St s)
ref <- Evt m a -> St s -> m (Ref m (St s))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt (s -> St s
forall a. a -> St a
Cont s
init)

  m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      St s
st <- IO (St s) -> m (St s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (St s) -> m (St s)) -> IO (St s) -> m (St s)
forall a b. (a -> b) -> a -> b
$ Ref m (St s) -> IO (St s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (St s)
ref
      case St s
st of
        Final s
s -> m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
        Cont s
s  -> do
          Maybe (St s)
mS' <- a -> s -> m (Maybe (St s))
modify a
x s
s
          Maybe (St s) -> (St s -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (St s)
mS' ((St s -> m ()) -> m ()) -> (St s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
            Cont s
s  -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (St s) -> St s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (St s)
ref (s -> St s
forall a. a -> St a
Cont s
s)
            Final s
s -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
              Ref m (St s) -> St s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (St s)
ref (s -> St s
forall a. a -> St a
Final s
s)
              IO ()
forall (m :: * -> *). Frp m => m ()
stopSelf

  St s
st <- IO (St s) -> m (St s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (St s) -> IO (St s)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (St s)
ref)
  case St s
st of
    Final s
s -> s -> m (Maybe b)
get s
s
    St s
_       -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing

heads :: Frp m => Evt m a -> m a
heads :: Evt m a -> m a
heads Evt m a
evt = do
  Ref m (Maybe a)
ref <- Evt m a -> Maybe a -> m (Ref m (Maybe a))
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt Maybe a
forall a. Maybe a
Nothing
  m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m (Maybe a) -> Maybe a -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m (Maybe a)
ref (a -> Maybe a
forall a. a -> Maybe a
Just a
x)
      m ()
forall (m :: * -> *). Frp m => m ()
stopSelf
  Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> m (Maybe a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Ref m (Maybe a) -> IO (Maybe a)
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m (Maybe a)
ref)

-- | Reads single event
takeP :: Frp m => Parser m a b -> Evt m a -> Evt m b
takeP :: Parser m a b -> Evt m a -> Evt m b
takeP (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe b)
get) Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
init
  m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      s
s <- IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref
      Maybe (St s)
mS' <- a -> s -> m (Maybe (St s))
modify a
x s
s
      Maybe (St s) -> (St s -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (St s)
mS' ((St s -> m ()) -> m ()) -> (St s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
        Cont s
s'  -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s'
        Final s
s' -> do
          (b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> m (Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Maybe b)
get s
s'
          m ()
forall (m :: * -> *). Frp m => m ()
stopSelf

cycleP :: Frp m => Parser m a b -> Evt m a -> Evt m b
cycleP :: Parser m a b -> Evt m a -> Evt m b
cycleP (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe b)
get) Evt m a
evt = ((b -> m ()) -> m ()) -> Evt m b
forall (m :: * -> *) a. ((a -> m ()) -> m ()) -> Evt m a
Evt (((b -> m ()) -> m ()) -> Evt m b)
-> ((b -> m ()) -> m ()) -> Evt m b
forall a b. (a -> b) -> a -> b
$ \b -> m ()
go -> do
  Ref m s
ref <- Evt m a -> s -> m (Ref m s)
forall (m :: * -> *) a b. Frp m => Evt m a -> b -> m (Ref m b)
proxyNewRef Evt m a
evt s
init
  m () -> m ()
forall (m :: * -> *). Frp m => m () -> m ()
waitAsync (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Evt m a -> (a -> m ()) -> m ()
forall (m :: * -> *) a. Evt m a -> (a -> m ()) -> m ()
runEvt Evt m a
evt ((a -> m ()) -> m ()) -> (a -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \a
x -> do
      s
s <- IO s -> m s
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO s -> m s) -> IO s -> m s
forall a b. (a -> b) -> a -> b
$ Ref m s -> IO s
forall (ref :: * -> *) a. IsRef ref => ref a -> IO a
readRef Ref m s
ref
      Maybe (St s)
mS' <- a -> s -> m (Maybe (St s))
modify a
x s
s
      Maybe (St s) -> (St s -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe (St s)
mS' ((St s -> m ()) -> m ()) -> (St s -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \case
        Cont s
s'  -> IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
s'
        Final s
s' -> do
          (b -> m ()) -> Maybe b -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ b -> m ()
go (Maybe b -> m ()) -> m (Maybe b) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< s -> m (Maybe b)
get s
s'
          IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Ref m s -> s -> IO ()
forall (ref :: * -> *) a. IsRef ref => ref a -> a -> IO ()
writeRef Ref m s
ref s
init

-- | Takes first element of the event stream and shuts the stream down.
headP :: Frp m => Parser m a a
headP :: Parser m a a
headP = Maybe a
-> (a -> Maybe a -> m (Maybe (St (Maybe a))))
-> (Maybe a -> m (Maybe a))
-> Parser m a a
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser Maybe a
forall a. Maybe a
init a -> Maybe a -> m (Maybe (St (Maybe a)))
forall (f :: * -> *) a p.
Applicative f =>
a -> p -> f (Maybe (St (Maybe a)))
modify Maybe a -> m (Maybe a)
forall a. a -> m a
get
  where
    init :: Maybe a
init = Maybe a
forall a. Maybe a
Nothing
    modify :: a -> p -> f (Maybe (St (Maybe a)))
modify a
a p
_ = Maybe (St (Maybe a)) -> f (Maybe (St (Maybe a)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (Maybe a)) -> f (Maybe (St (Maybe a))))
-> Maybe (St (Maybe a)) -> f (Maybe (St (Maybe a)))
forall a b. (a -> b) -> a -> b
$ St (Maybe a) -> Maybe (St (Maybe a))
forall a. a -> Maybe a
Just (Maybe a -> St (Maybe a)
forall a. a -> St a
Final (a -> Maybe a
forall a. a -> Maybe a
Just a
a))
    get :: a -> m a
get = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

maybeP :: Frp m => (a -> Maybe b) -> Parser m a b
maybeP :: (a -> Maybe b) -> Parser m a b
maybeP a -> Maybe b
f = Maybe b
-> (a -> Maybe b -> m (Maybe (St (Maybe b))))
-> (Maybe b -> m (Maybe b))
-> Parser m a b
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser Maybe b
forall a. Maybe a
init a -> Maybe b -> m (Maybe (St (Maybe b)))
modify Maybe b -> m (Maybe b)
forall a. a -> m a
get
  where
    init :: Maybe a
init = Maybe a
forall a. Maybe a
Nothing
    modify :: a -> Maybe b -> m (Maybe (St (Maybe b)))
modify a
a Maybe b
_ = Maybe (St (Maybe b)) -> m (Maybe (St (Maybe b)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (Maybe b)) -> m (Maybe (St (Maybe b))))
-> Maybe (St (Maybe b)) -> m (Maybe (St (Maybe b)))
forall a b. (a -> b) -> a -> b
$ (b -> St (Maybe b)) -> Maybe b -> Maybe (St (Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe b -> St (Maybe b)
forall a. a -> St a
Final (Maybe b -> St (Maybe b)) -> (b -> Maybe b) -> b -> St (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just) (Maybe b -> Maybe (St (Maybe b)))
-> Maybe b -> Maybe (St (Maybe b))
forall a b. (a -> b) -> a -> b
$ a -> Maybe b
f a
a
    get :: a -> m a
get = a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance Frp m => Functor (Parser m a) where
  fmap :: (a -> b) -> Parser m a a -> Parser m a b
fmap a -> b
f (Parser s
init a -> s -> m (Maybe (St s))
modify s -> m (Maybe a)
get) = s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser s
init a -> s -> m (Maybe (St s))
modify ((Maybe a -> Maybe b) -> m (Maybe a) -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (m (Maybe a) -> m (Maybe b))
-> (s -> m (Maybe a)) -> s -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m (Maybe a)
get)

instance Frp m => Applicative (Parser m a) where
  pure :: a -> Parser m a a
pure a
a = ()
-> (a -> () -> m (Maybe (St ())))
-> (() -> m (Maybe a))
-> Parser m a a
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser () (\a
_ ()
_ -> Maybe (St ()) -> m (Maybe (St ()))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (St () -> Maybe (St ())
forall a. a -> Maybe a
Just (() -> St ()
forall a. a -> St a
Final ()))) (m (Maybe a) -> () -> m (Maybe a)
forall a b. a -> b -> a
const (m (Maybe a) -> () -> m (Maybe a))
-> m (Maybe a) -> () -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a)
  (Parser s
initF a -> s -> m (Maybe (St s))
modifyF s -> m (Maybe (a -> b))
getF) <*> :: Parser m a (a -> b) -> Parser m a a -> Parser m a b
<*> (Parser s
initA a -> s -> m (Maybe (St s))
modifyA s -> m (Maybe a)
getA) = (St s, St s)
-> (a -> (St s, St s) -> m (Maybe (St (St s, St s))))
-> ((St s, St s) -> m (Maybe b))
-> Parser m a b
forall (m :: * -> *) a b s.
s
-> (a -> s -> m (Maybe (St s)))
-> (s -> m (Maybe b))
-> Parser m a b
Parser (St s, St s)
initRes a -> (St s, St s) -> m (Maybe (St (St s, St s)))
modifyRes (St s, St s) -> m (Maybe b)
getRes
    where
      initRes :: (St s, St s)
initRes = (s -> St s
forall a. a -> St a
Cont s
initF, s -> St s
forall a. a -> St a
Cont s
initA)

      modifyRes :: a -> (St s, St s) -> m (Maybe (St (St s, St s)))
modifyRes a
inp (St s
sf, St s
sa) = case St s
sf of
        Cont s
f -> do
          Maybe (St s)
mF' <- a -> s -> m (Maybe (St s))
modifyF a
inp s
f
          Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s))))
-> Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall a b. (a -> b) -> a -> b
$ (St s -> St (St s, St s))
-> Maybe (St s) -> Maybe (St (St s, St s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((St s, St s) -> St (St s, St s)
forall a. a -> St a
Cont ((St s, St s) -> St (St s, St s))
-> (St s -> (St s, St s)) -> St s -> St (St s, St s)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, St s
sa)) Maybe (St s)
mF'
        Final s
f ->
          case St s
sa of
            Cont s
a -> do
              Maybe (St s)
mA' <- a -> s -> m (Maybe (St s))
modifyA a
inp s
a
              Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s))))
-> Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall a b. (a -> b) -> a -> b
$ ((St s -> St (St s, St s))
 -> Maybe (St s) -> Maybe (St (St s, St s)))
-> Maybe (St s)
-> (St s -> St (St s, St s))
-> Maybe (St (St s, St s))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (St s -> St (St s, St s))
-> Maybe (St s) -> Maybe (St (St s, St s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (St s)
mA' ((St s -> St (St s, St s)) -> Maybe (St (St s, St s)))
-> (St s -> St (St s, St s)) -> Maybe (St (St s, St s))
forall a b. (a -> b) -> a -> b
$ \case
                  Cont s
a'  -> (St s, St s) -> St (St s, St s)
forall a. a -> St a
Cont (s -> St s
forall a. a -> St a
Final s
f, s -> St s
forall a. a -> St a
Cont s
a')
                  Final s
a' -> (St s, St s) -> St (St s, St s)
forall a. a -> St a
Final (s -> St s
forall a. a -> St a
Final s
f, s -> St s
forall a. a -> St a
Final s
a')
            Final s
a -> Maybe (St (St s, St s)) -> m (Maybe (St (St s, St s)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (St (St s, St s) -> Maybe (St (St s, St s))
forall a. a -> Maybe a
Just ((St s, St s) -> St (St s, St s)
forall a. a -> St a
Final (St s
sf, St s
sa)))

      getRes :: (St s, St s) -> m (Maybe b)
getRes = \case
        (Final s
f, Final s
a) -> do
          Maybe (a -> b)
mf <- s -> m (Maybe (a -> b))
getF s
f
          Maybe a
ma <- s -> m (Maybe a)
getA s
a
          Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (a -> b)
mf Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe a
ma)
        (St s, St s)
_                  -> Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing


-- | Create a new Event and a function that will cause the Event to fire
newTriggerEvt :: (Frp m, MonadIO io) => m (Evt m a, a -> io ())
newTriggerEvt :: m (Evt m a, a -> io ())
newTriggerEvt = do
  (InChan a, OutChan a)
chan <- IO (InChan a, OutChan a) -> m (InChan a, OutChan a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (InChan a, OutChan a)
forall a. IO (InChan a, OutChan a)
U.newChan
  (Evt m a, a -> io ()) -> m (Evt m a, a -> io ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (InChan a -> Evt m a
forall (m :: * -> *) a. Frp m => InChan a -> Evt m a
uchanEvt ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan), IO () -> io ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> io ()) -> (a -> IO ()) -> a -> io ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InChan a -> a -> IO ()
forall a. InChan a -> a -> IO ()
U.writeChan ((InChan a, OutChan a) -> InChan a
forall a b. (a, b) -> a
fst (InChan a, OutChan a)
chan))