{-# LANGUAGE CPP #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE PolyKinds #-}

#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif

-- There are two expected orphan instances in this module:
--   * MonadSample (Pure t) ((->) t)
--   * MonadHold (Pure t) ((->) t)
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module: Reflex.Pure
-- Description:
--   This module provides a pure implementation of Reflex, which is intended to
--   serve as a reference for the semantics of the Reflex class.  All
--   implementations of Reflex should produce the same results as this
--   implementation, although performance and laziness/strictness may differ.
module Reflex.Pure
  ( Pure
  , Behavior (..)
  , Event (..)
  , Dynamic (..)
  , Incremental (..)
  ) where

import Control.Monad
import Data.Dependent.Map (DMap)
import Data.GADT.Compare (GCompare)
import qualified Data.Dependent.Map as DMap
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Maybe
import Data.MemoTrie
import Data.Monoid
import Data.Type.Coercion
import Reflex.Class
import Data.Kind (Type)

-- | A completely pure-functional 'Reflex' timeline, identifying moments in time
-- with the type @/t/@.
data Pure (t :: Type)

-- | The 'Enum' instance of @/t/@ must be dense: for all @/x :: t/@, there must not exist
-- any @/y :: t/@ such that @/'pred' x < y < x/@. The 'HasTrie' instance will be used
-- exclusively to memoize functions of @/t/@, not for any of its other capabilities.
instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

  newtype Behavior (Pure t) a = Behavior { Behavior (Pure t) a -> t -> a
unBehavior :: t -> a }
  newtype Event (Pure t) a = Event { Event (Pure t) a -> t -> Maybe a
unEvent :: t -> Maybe a }
  newtype Dynamic (Pure t) a = Dynamic { Dynamic (Pure t) a -> t -> (a, Maybe a)
unDynamic :: t -> (a, Maybe a) }
  newtype Incremental (Pure t) p = Incremental { Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
unIncremental :: t -> (PatchTarget p, Maybe p) }

  type PushM (Pure t) = (->) t
  type PullM (Pure t) = (->) t

  never :: Event (Pure t) a
  never :: Event (Pure t) a
never = (t -> Maybe a) -> Event (Pure t) a
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe a) -> Event (Pure t) a)
-> (t -> Maybe a) -> Event (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
_ -> Maybe a
forall a. Maybe a
Nothing

  constant :: a -> Behavior (Pure t) a
  constant :: a -> Behavior (Pure t) a
constant a
x = (t -> a) -> Behavior (Pure t) a
forall t a. (t -> a) -> Behavior (Pure t) a
Behavior ((t -> a) -> Behavior (Pure t) a)
-> (t -> a) -> Behavior (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
_ -> a
x

  push :: (a -> PushM (Pure t) (Maybe b)) -> Event (Pure t) a -> Event (Pure t) b
  push :: (a -> PushM (Pure t) (Maybe b))
-> Event (Pure t) a -> Event (Pure t) b
push a -> PushM (Pure t) (Maybe b)
f Event (Pure t) a
e = (t -> Maybe b) -> Event (Pure t) b
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe b) -> Event (Pure t) b)
-> (t -> Maybe b) -> Event (Pure t) b
forall a b. (a -> b) -> a -> b
$ (t -> Maybe b) -> t -> Maybe b
forall t a. HasTrie t => (t -> a) -> t -> a
memo ((t -> Maybe b) -> t -> Maybe b) -> (t -> Maybe b) -> t -> Maybe b
forall a b. (a -> b) -> a -> b
$ \t
t -> Event (Pure t) a -> t -> Maybe a
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) a
e t
t Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
o -> a -> PushM (Pure t) (Maybe b)
a -> t -> Maybe b
f a
o t
t

  pushCheap :: (a -> PushM (Pure t) (Maybe b)) -> Event (Pure t) a -> Event (Pure t) b
  pushCheap :: (a -> PushM (Pure t) (Maybe b))
-> Event (Pure t) a -> Event (Pure t) b
pushCheap = (a -> PushM (Pure t) (Maybe b))
-> Event (Pure t) a -> Event (Pure t) b
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push

  pull :: PullM (Pure t) a -> Behavior (Pure t) a
  pull :: PullM (Pure t) a -> Behavior (Pure t) a
pull = (t -> a) -> Behavior (Pure t) a
forall t a. (t -> a) -> Behavior (Pure t) a
Behavior ((t -> a) -> Behavior (Pure t) a)
-> ((t -> a) -> t -> a) -> (t -> a) -> Behavior (Pure t) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> a) -> t -> a
forall t a. HasTrie t => (t -> a) -> t -> a
memo

  -- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a
  -- warning because the GCompare instance is not used; however, removing the
  -- GCompare instance produces a different warning, due to that constraint
  -- being present in the original class definition.

  --mergeG :: GCompare k => (forall a. q a -> Event (Pure t) (v a))
  --   -> DMap k q -> Event (Pure t) (DMap k v)
  mergeG :: (forall (a :: k). q a -> Event (Pure t) (v a))
-> DMap k q -> Event (Pure t) (DMap k v)
mergeG forall (a :: k). q a -> Event (Pure t) (v a)
nt DMap k q
events = (t -> Maybe (DMap k v)) -> Event (Pure t) (DMap k v)
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe (DMap k v)) -> Event (Pure t) (DMap k v))
-> (t -> Maybe (DMap k v)) -> Event (Pure t) (DMap k v)
forall a b. (a -> b) -> a -> b
$ (t -> Maybe (DMap k v)) -> t -> Maybe (DMap k v)
forall t a. HasTrie t => (t -> a) -> t -> a
memo ((t -> Maybe (DMap k v)) -> t -> Maybe (DMap k v))
-> (t -> Maybe (DMap k v)) -> t -> Maybe (DMap k v)
forall a b. (a -> b) -> a -> b
$ \t
t ->
    let currentOccurrences :: DMap k v
currentOccurrences = (forall (v :: k). k v -> q v -> Maybe (v v))
-> DMap k q -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Maybe (g v))
-> DMap k2 f -> DMap k2 g
DMap.mapMaybeWithKey (\k v
_ q v
q -> case q v -> Event (Pure t) (v v)
forall (a :: k). q a -> Event (Pure t) (v a)
nt q v
q of Event a -> t -> Maybe (v v)
a t
t) DMap k q
events
    in if DMap k v -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k v
currentOccurrences
       then Maybe (DMap k v)
forall a. Maybe a
Nothing
       else DMap k v -> Maybe (DMap k v)
forall a. a -> Maybe a
Just DMap k v
currentOccurrences

--  The instance signature doeesn't compile, leave commented for documentation
--  fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v
  fanG :: Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v
fanG Event (Pure t) (DMap k v)
e = (forall (a :: k). k a -> Event (Pure t) (v a))
-> EventSelectorG (Pure t) k v
forall k k (t :: k) (k :: k -> *) (v :: k -> *).
(forall (a :: k). k a -> Event t (v a)) -> EventSelectorG t k v
EventSelectorG ((forall (a :: k). k a -> Event (Pure t) (v a))
 -> EventSelectorG (Pure t) k v)
-> (forall (a :: k). k a -> Event (Pure t) (v a))
-> EventSelectorG (Pure t) k v
forall a b. (a -> b) -> a -> b
$ \k a
k -> (t -> Maybe (v a)) -> Event (Pure t) (v a)
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe (v a)) -> Event (Pure t) (v a))
-> (t -> Maybe (v a)) -> Event (Pure t) (v a)
forall a b. (a -> b) -> a -> b
$ \t
t -> Event (Pure t) (DMap k v) -> t -> Maybe (DMap k v)
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) (DMap k v)
e t
t Maybe (DMap k v) -> (DMap k v -> Maybe (v a)) -> Maybe (v a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= k a -> DMap k v -> Maybe (v a)
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DMap.lookup k a
k

  switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
  switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
switch Behavior (Pure t) (Event (Pure t) a)
b = (t -> Maybe a) -> Event (Pure t) a
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe a) -> Event (Pure t) a)
-> (t -> Maybe a) -> Event (Pure t) a
forall a b. (a -> b) -> a -> b
$ (t -> Maybe a) -> t -> Maybe a
forall t a. HasTrie t => (t -> a) -> t -> a
memo ((t -> Maybe a) -> t -> Maybe a) -> (t -> Maybe a) -> t -> Maybe a
forall a b. (a -> b) -> a -> b
$ \t
t -> Event (Pure t) a -> t -> Maybe a
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent (Behavior (Pure t) (Event (Pure t) a) -> t -> Event (Pure t) a
forall t a. Behavior (Pure t) a -> t -> a
unBehavior Behavior (Pure t) (Event (Pure t) a)
b t
t) t
t

  coincidence :: Event (Pure t) (Event (Pure t) a) -> Event (Pure t) a
  coincidence :: Event (Pure t) (Event (Pure t) a) -> Event (Pure t) a
coincidence Event (Pure t) (Event (Pure t) a)
e = (t -> Maybe a) -> Event (Pure t) a
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe a) -> Event (Pure t) a)
-> (t -> Maybe a) -> Event (Pure t) a
forall a b. (a -> b) -> a -> b
$ (t -> Maybe a) -> t -> Maybe a
forall t a. HasTrie t => (t -> a) -> t -> a
memo ((t -> Maybe a) -> t -> Maybe a) -> (t -> Maybe a) -> t -> Maybe a
forall a b. (a -> b) -> a -> b
$ \t
t -> Event (Pure t) (Event (Pure t) a) -> t -> Maybe (Event (Pure t) a)
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) (Event (Pure t) a)
e t
t Maybe (Event (Pure t) a)
-> (Event (Pure t) a -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Event (Pure t) a
o -> Event (Pure t) a -> t -> Maybe a
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) a
o t
t

  current :: Dynamic (Pure t) a -> Behavior (Pure t) a
  current :: Dynamic (Pure t) a -> Behavior (Pure t) a
current Dynamic (Pure t) a
d = (t -> a) -> Behavior (Pure t) a
forall t a. (t -> a) -> Behavior (Pure t) a
Behavior ((t -> a) -> Behavior (Pure t) a)
-> (t -> a) -> Behavior (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
t -> (a, Maybe a) -> a
forall a b. (a, b) -> a
fst ((a, Maybe a) -> a) -> (a, Maybe a) -> a
forall a b. (a -> b) -> a -> b
$ Dynamic (Pure t) a -> t -> (a, Maybe a)
forall t a. Dynamic (Pure t) a -> t -> (a, Maybe a)
unDynamic Dynamic (Pure t) a
d t
t

  updated :: Dynamic (Pure t) a -> Event (Pure t) a
  updated :: Dynamic (Pure t) a -> Event (Pure t) a
updated Dynamic (Pure t) a
d = (t -> Maybe a) -> Event (Pure t) a
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe a) -> Event (Pure t) a)
-> (t -> Maybe a) -> Event (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
t -> (a, Maybe a) -> Maybe a
forall a b. (a, b) -> b
snd ((a, Maybe a) -> Maybe a) -> (a, Maybe a) -> Maybe a
forall a b. (a -> b) -> a -> b
$ Dynamic (Pure t) a -> t -> (a, Maybe a)
forall t a. Dynamic (Pure t) a -> t -> (a, Maybe a)
unDynamic Dynamic (Pure t) a
d t
t

  unsafeBuildDynamic :: PullM (Pure t) a -> Event (Pure t) a -> Dynamic (Pure t) a
  unsafeBuildDynamic :: PullM (Pure t) a -> Event (Pure t) a -> Dynamic (Pure t) a
unsafeBuildDynamic PullM (Pure t) a
readV0 Event (Pure t) a
v' = (t -> (a, Maybe a)) -> Dynamic (Pure t) a
forall t a. (t -> (a, Maybe a)) -> Dynamic (Pure t) a
Dynamic ((t -> (a, Maybe a)) -> Dynamic (Pure t) a)
-> (t -> (a, Maybe a)) -> Dynamic (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
t -> (PullM (Pure t) a
t -> a
readV0 t
t, Event (Pure t) a -> t -> Maybe a
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) a
v' t
t)

  -- See UNUSED_CONSTRAINT, above.

  --unsafeBuildIncremental :: Patch p => PullM (Pure t) a -> Event (Pure t) (p
  --a) -> Incremental (Pure t) p a
  unsafeBuildIncremental :: PullM (Pure t) (PatchTarget p)
-> Event (Pure t) p -> Incremental (Pure t) p
unsafeBuildIncremental PullM (Pure t) (PatchTarget p)
readV0 Event (Pure t) p
p = (t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p
forall t p.
(t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p
Incremental ((t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p)
-> (t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p
forall a b. (a -> b) -> a -> b
$ \t
t -> (PullM (Pure t) (PatchTarget p)
t -> PatchTarget p
readV0 t
t, Event (Pure t) p -> t -> Maybe p
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) p
p t
t)

  mergeIncrementalG :: (forall (a :: k). q a -> Event (Pure t) (v a))
-> Incremental (Pure t) (PatchDMap k q)
-> Event (Pure t) (DMap k v)
mergeIncrementalG = (forall (a :: k). q a -> Event (Pure t) (v a))
-> Incremental (Pure t) (PatchDMap k q)
-> Event (Pure t) (DMap k v)
forall k p (k :: k -> *) (q :: k -> *) t (v :: k -> *).
(PatchTarget p ~ DMap k q, GCompare k) =>
(forall (a :: k). q a -> Event (Pure t) (v a))
-> Incremental (Pure t) p -> Event (Pure t) (DMap k v)
mergeIncrementalImpl
  mergeIncrementalWithMoveG :: (forall (a :: k). q a -> Event (Pure t) (v a))
-> Incremental (Pure t) (PatchDMapWithMove k q)
-> Event (Pure t) (DMap k v)
mergeIncrementalWithMoveG = (forall (a :: k). q a -> Event (Pure t) (v a))
-> Incremental (Pure t) (PatchDMapWithMove k q)
-> Event (Pure t) (DMap k v)
forall k p (k :: k -> *) (q :: k -> *) t (v :: k -> *).
(PatchTarget p ~ DMap k q, GCompare k) =>
(forall (a :: k). q a -> Event (Pure t) (v a))
-> Incremental (Pure t) p -> Event (Pure t) (DMap k v)
mergeIncrementalImpl

  currentIncremental :: Incremental (Pure t) p -> Behavior (Pure t) (PatchTarget p)
currentIncremental Incremental (Pure t) p
i = (t -> PatchTarget p) -> Behavior (Pure t) (PatchTarget p)
forall t a. (t -> a) -> Behavior (Pure t) a
Behavior ((t -> PatchTarget p) -> Behavior (Pure t) (PatchTarget p))
-> (t -> PatchTarget p) -> Behavior (Pure t) (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ \t
t -> (PatchTarget p, Maybe p) -> PatchTarget p
forall a b. (a, b) -> a
fst ((PatchTarget p, Maybe p) -> PatchTarget p)
-> (PatchTarget p, Maybe p) -> PatchTarget p
forall a b. (a -> b) -> a -> b
$ Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
forall t p. Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
unIncremental Incremental (Pure t) p
i t
t

  updatedIncremental :: Incremental (Pure t) p -> Event (Pure t) p
updatedIncremental Incremental (Pure t) p
i = (t -> Maybe p) -> Event (Pure t) p
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe p) -> Event (Pure t) p)
-> (t -> Maybe p) -> Event (Pure t) p
forall a b. (a -> b) -> a -> b
$ \t
t -> (PatchTarget p, Maybe p) -> Maybe p
forall a b. (a, b) -> b
snd ((PatchTarget p, Maybe p) -> Maybe p)
-> (PatchTarget p, Maybe p) -> Maybe p
forall a b. (a -> b) -> a -> b
$ Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
forall t p. Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
unIncremental Incremental (Pure t) p
i t
t

  incrementalToDynamic :: Incremental (Pure t) p -> Dynamic (Pure t) (PatchTarget p)
incrementalToDynamic Incremental (Pure t) p
i = (t -> (PatchTarget p, Maybe (PatchTarget p)))
-> Dynamic (Pure t) (PatchTarget p)
forall t a. (t -> (a, Maybe a)) -> Dynamic (Pure t) a
Dynamic ((t -> (PatchTarget p, Maybe (PatchTarget p)))
 -> Dynamic (Pure t) (PatchTarget p))
-> (t -> (PatchTarget p, Maybe (PatchTarget p)))
-> Dynamic (Pure t) (PatchTarget p)
forall a b. (a -> b) -> a -> b
$ \t
t ->
    let (PatchTarget p
old, Maybe p
mPatch) = Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
forall t p. Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
unIncremental Incremental (Pure t) p
i t
t
        e :: Maybe (PatchTarget p)
e = case Maybe p
mPatch of
          Maybe p
Nothing -> Maybe (PatchTarget p)
forall a. Maybe a
Nothing
          Just p
patch -> p -> PatchTarget p -> Maybe (PatchTarget p)
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply p
patch PatchTarget p
old
    in (PatchTarget p
old, Maybe (PatchTarget p)
e)
  behaviorCoercion :: Coercion a b
-> Coercion (Behavior (Pure t) a) (Behavior (Pure t) b)
behaviorCoercion Coercion a b
Coercion = Coercion (Behavior (Pure t) a) (Behavior (Pure t) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  eventCoercion :: Coercion a b -> Coercion (Event (Pure t) a) (Event (Pure t) b)
eventCoercion Coercion a b
Coercion = Coercion (Event (Pure t) a) (Event (Pure t) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  dynamicCoercion :: Coercion a b -> Coercion (Dynamic (Pure t) a) (Dynamic (Pure t) b)
dynamicCoercion Coercion a b
Coercion = Coercion (Dynamic (Pure t) a) (Dynamic (Pure t) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion
  incrementalCoercion :: Coercion (PatchTarget a) (PatchTarget b)
-> Coercion a b
-> Coercion (Incremental (Pure t) a) (Incremental (Pure t) b)
incrementalCoercion Coercion (PatchTarget a) (PatchTarget b)
Coercion Coercion a b
Coercion = Coercion (Incremental (Pure t) a) (Incremental (Pure t) b)
forall k (a :: k) (b :: k). Coercible a b => Coercion a b
Coercion

  fanInt :: Event (Pure t) (IntMap a) -> EventSelectorInt (Pure t) a
fanInt Event (Pure t) (IntMap a)
e = (Int -> Event (Pure t) a) -> EventSelectorInt (Pure t) a
forall k (t :: k) a. (Int -> Event t a) -> EventSelectorInt t a
EventSelectorInt ((Int -> Event (Pure t) a) -> EventSelectorInt (Pure t) a)
-> (Int -> Event (Pure t) a) -> EventSelectorInt (Pure t) a
forall a b. (a -> b) -> a -> b
$ \Int
k -> (t -> Maybe a) -> Event (Pure t) a
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe a) -> Event (Pure t) a)
-> (t -> Maybe a) -> Event (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
t -> Event (Pure t) (IntMap a) -> t -> Maybe (IntMap a)
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) (IntMap a)
e t
t Maybe (IntMap a) -> (IntMap a -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> IntMap a -> Maybe a
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
k

  mergeIntIncremental :: Incremental (Pure t) (PatchIntMap (Event (Pure t) a))
-> Event (Pure t) (IntMap a)
mergeIntIncremental = Incremental (Pure t) (PatchIntMap (Event (Pure t) a))
-> Event (Pure t) (IntMap a)
forall p t a.
(PatchTarget p ~ IntMap (Event (Pure t) a)) =>
Incremental (Pure t) p -> Event (Pure t) (IntMap a)
mergeIntIncrementalImpl

mergeIncrementalImpl :: (PatchTarget p ~ DMap k q, GCompare k)
  => (forall a. q a -> Event (Pure t) (v a))
  -> Incremental (Pure t) p -> Event (Pure t) (DMap k v)
mergeIncrementalImpl :: (forall (a :: k). q a -> Event (Pure t) (v a))
-> Incremental (Pure t) p -> Event (Pure t) (DMap k v)
mergeIncrementalImpl forall (a :: k). q a -> Event (Pure t) (v a)
nt Incremental (Pure t) p
i = (t -> Maybe (DMap k v)) -> Event (Pure t) (DMap k v)
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe (DMap k v)) -> Event (Pure t) (DMap k v))
-> (t -> Maybe (DMap k v)) -> Event (Pure t) (DMap k v)
forall a b. (a -> b) -> a -> b
$ \t
t ->
  let results :: DMap k v
results = (forall (v :: k). k v -> q v -> Maybe (v v))
-> DMap k q -> DMap k v
forall k1 (k2 :: k1 -> *) (f :: k1 -> *) (g :: k1 -> *).
GCompare k2 =>
(forall (v :: k1). k2 v -> f v -> Maybe (g v))
-> DMap k2 f -> DMap k2 g
DMap.mapMaybeWithKey (\k v
_ q v
q -> case q v -> Event (Pure t) (v v)
forall (a :: k). q a -> Event (Pure t) (v a)
nt q v
q of Event e -> t -> Maybe (v v)
e t
t) (DMap k q -> DMap k v) -> DMap k q -> DMap k v
forall a b. (a -> b) -> a -> b
$ (DMap k q, Maybe p) -> DMap k q
forall a b. (a, b) -> a
fst ((DMap k q, Maybe p) -> DMap k q)
-> (DMap k q, Maybe p) -> DMap k q
forall a b. (a -> b) -> a -> b
$ Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
forall t p. Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
unIncremental Incremental (Pure t) p
i t
t
  in if DMap k v -> Bool
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> Bool
DMap.null DMap k v
results
     then Maybe (DMap k v)
forall a. Maybe a
Nothing
     else DMap k v -> Maybe (DMap k v)
forall a. a -> Maybe a
Just DMap k v
results

mergeIntIncrementalImpl :: (PatchTarget p ~ IntMap (Event (Pure t) a)) => Incremental (Pure t) p -> Event (Pure t) (IntMap a)
mergeIntIncrementalImpl :: Incremental (Pure t) p -> Event (Pure t) (IntMap a)
mergeIntIncrementalImpl Incremental (Pure t) p
i = (t -> Maybe (IntMap a)) -> Event (Pure t) (IntMap a)
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe (IntMap a)) -> Event (Pure t) (IntMap a))
-> (t -> Maybe (IntMap a)) -> Event (Pure t) (IntMap a)
forall a b. (a -> b) -> a -> b
$ \t
t ->
  let results :: IntMap a
results = (Int -> Event (Pure t) a -> Maybe a)
-> IntMap (Event (Pure t) a) -> IntMap a
forall a b. (Int -> a -> Maybe b) -> IntMap a -> IntMap b
IntMap.mapMaybeWithKey (\Int
_ (Event e) -> t -> Maybe a
e t
t) (IntMap (Event (Pure t) a) -> IntMap a)
-> IntMap (Event (Pure t) a) -> IntMap a
forall a b. (a -> b) -> a -> b
$ (IntMap (Event (Pure t) a), Maybe p) -> IntMap (Event (Pure t) a)
forall a b. (a, b) -> a
fst ((IntMap (Event (Pure t) a), Maybe p) -> IntMap (Event (Pure t) a))
-> (IntMap (Event (Pure t) a), Maybe p)
-> IntMap (Event (Pure t) a)
forall a b. (a -> b) -> a -> b
$ Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
forall t p. Incremental (Pure t) p -> t -> (PatchTarget p, Maybe p)
unIncremental Incremental (Pure t) p
i t
t
  in if IntMap a -> Bool
forall a. IntMap a -> Bool
IntMap.null IntMap a
results
     then Maybe (IntMap a)
forall a. Maybe a
Nothing
     else IntMap a -> Maybe (IntMap a)
forall a. a -> Maybe a
Just IntMap a
results

instance Functor (Dynamic (Pure t)) where
  fmap :: (a -> b) -> Dynamic (Pure t) a -> Dynamic (Pure t) b
fmap a -> b
f Dynamic (Pure t) a
d = (t -> (b, Maybe b)) -> Dynamic (Pure t) b
forall t a. (t -> (a, Maybe a)) -> Dynamic (Pure t) a
Dynamic ((t -> (b, Maybe b)) -> Dynamic (Pure t) b)
-> (t -> (b, Maybe b)) -> Dynamic (Pure t) b
forall a b. (a -> b) -> a -> b
$ \t
t -> let (a
cur, Maybe a
upd) = Dynamic (Pure t) a -> t -> (a, Maybe a)
forall t a. Dynamic (Pure t) a -> t -> (a, Maybe a)
unDynamic Dynamic (Pure t) a
d t
t
                             in (a -> b
f a
cur, (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Maybe a
upd)

instance Applicative (Dynamic (Pure t)) where
  pure :: a -> Dynamic (Pure t) a
pure a
a = (t -> (a, Maybe a)) -> Dynamic (Pure t) a
forall t a. (t -> (a, Maybe a)) -> Dynamic (Pure t) a
Dynamic ((t -> (a, Maybe a)) -> Dynamic (Pure t) a)
-> (t -> (a, Maybe a)) -> Dynamic (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
_ -> (a
a, Maybe a
forall a. Maybe a
Nothing)
  <*> :: Dynamic (Pure t) (a -> b)
-> Dynamic (Pure t) a -> Dynamic (Pure t) b
(<*>) = Dynamic (Pure t) (a -> b)
-> Dynamic (Pure t) a -> Dynamic (Pure t) b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance Monad (Dynamic (Pure t)) where
  return :: a -> Dynamic (Pure t) a
return = a -> Dynamic (Pure t) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  (Dynamic (Pure t) a
x :: Dynamic (Pure t) a) >>= :: Dynamic (Pure t) a
-> (a -> Dynamic (Pure t) b) -> Dynamic (Pure t) b
>>= (a -> Dynamic (Pure t) b
f :: a -> Dynamic (Pure t) b) = (t -> (b, Maybe b)) -> Dynamic (Pure t) b
forall t a. (t -> (a, Maybe a)) -> Dynamic (Pure t) a
Dynamic ((t -> (b, Maybe b)) -> Dynamic (Pure t) b)
-> (t -> (b, Maybe b)) -> Dynamic (Pure t) b
forall a b. (a -> b) -> a -> b
$ \t
t ->
    let (a
curX :: a, Maybe a
updX :: Maybe a) = Dynamic (Pure t) a -> t -> (a, Maybe a)
forall t a. Dynamic (Pure t) a -> t -> (a, Maybe a)
unDynamic Dynamic (Pure t) a
x t
t
        (b
cur :: b, Maybe b
updOuter :: Maybe b) = Dynamic (Pure t) b -> t -> (b, Maybe b)
forall t a. Dynamic (Pure t) a -> t -> (a, Maybe a)
unDynamic (a -> Dynamic (Pure t) b
f a
curX) t
t
        (Maybe b
updInner :: Maybe b, Maybe b
updBoth :: Maybe b) = case Maybe a
updX of
          Maybe a
Nothing -> (Maybe b
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing)
          Just a
nextX -> let (b
c, Maybe b
u) = Dynamic (Pure t) b -> t -> (b, Maybe b)
forall t a. Dynamic (Pure t) a -> t -> (a, Maybe a)
unDynamic (a -> Dynamic (Pure t) b
f a
nextX) t
t
                        in (b -> Maybe b
forall a. a -> Maybe a
Just b
c, Maybe b
u)
    in (b
cur, First b -> Maybe b
forall a. First a -> Maybe a
getFirst (First b -> Maybe b) -> First b -> Maybe b
forall a b. (a -> b) -> a -> b
$ [First b] -> First b
forall a. Monoid a => [a] -> a
mconcat ([First b] -> First b) -> [First b] -> First b
forall a b. (a -> b) -> a -> b
$ (Maybe b -> First b) -> [Maybe b] -> [First b]
forall a b. (a -> b) -> [a] -> [b]
map Maybe b -> First b
forall a. Maybe a -> First a
First [Maybe b
updBoth, Maybe b
updOuter, Maybe b
updInner])

instance MonadSample (Pure t) ((->) t) where

  sample :: Behavior (Pure t) a -> (t -> a)
  sample :: Behavior (Pure t) a -> t -> a
sample = Behavior (Pure t) a -> t -> a
forall t a. Behavior (Pure t) a -> t -> a
unBehavior

instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

  hold :: a -> Event (Pure t) a -> t -> Behavior (Pure t) a
  hold :: a -> Event (Pure t) a -> t -> Behavior (Pure t) a
hold a
initialValue Event (Pure t) a
e t
initialTime = (t -> a) -> Behavior (Pure t) a
forall t a. (t -> a) -> Behavior (Pure t) a
Behavior t -> a
f
    where f :: t -> a
f = (t -> a) -> t -> a
forall t a. HasTrie t => (t -> a) -> t -> a
memo ((t -> a) -> t -> a) -> (t -> a) -> t -> a
forall a b. (a -> b) -> a -> b
$ \t
sampleTime ->
            -- Really, the sampleTime should never be prior to the initialTime,
            -- because that would mean the Behavior is being sampled before
            -- being created.
            if t
sampleTime t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
initialTime
            then a
initialValue
            else let lastTime :: t
lastTime = t -> t
forall a. Enum a => a -> a
pred t
sampleTime
                 in a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (t -> a
f t
lastTime) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Event (Pure t) a -> t -> Maybe a
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) a
e t
lastTime

  holdDyn :: a -> Event (Pure t) a -> t -> Dynamic (Pure t) a
holdDyn a
v0 = PushM (Pure t) a -> Event (Pure t) a -> t -> Dynamic (Pure t) a
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (a -> t -> a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v0)

  buildDynamic :: (t -> a) -> Event (Pure t) a -> t -> Dynamic (Pure t) a
  buildDynamic :: (t -> a) -> Event (Pure t) a -> t -> Dynamic (Pure t) a
buildDynamic t -> a
initialValue Event (Pure t) a
e t
initialTime =
    let Behavior f = a -> Event (Pure t) a -> t -> Behavior (Pure t) a
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold (t -> a
initialValue t
initialTime) Event (Pure t) a
e t
initialTime
    in (t -> (a, Maybe a)) -> Dynamic (Pure t) a
forall t a. (t -> (a, Maybe a)) -> Dynamic (Pure t) a
Dynamic ((t -> (a, Maybe a)) -> Dynamic (Pure t) a)
-> (t -> (a, Maybe a)) -> Dynamic (Pure t) a
forall a b. (a -> b) -> a -> b
$ \t
t -> (t -> a
f t
t, Event (Pure t) a -> t -> Maybe a
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) a
e t
t)

  holdIncremental :: Patch p => PatchTarget p -> Event (Pure t) p -> t -> Incremental (Pure t) p
  holdIncremental :: PatchTarget p -> Event (Pure t) p -> t -> Incremental (Pure t) p
holdIncremental PatchTarget p
initialValue Event (Pure t) p
e t
initialTime = (t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p
forall t p.
(t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p
Incremental ((t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p)
-> (t -> (PatchTarget p, Maybe p)) -> Incremental (Pure t) p
forall a b. (a -> b) -> a -> b
$ \t
t -> (t -> PatchTarget p
f t
t, Event (Pure t) p -> t -> Maybe p
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) p
e t
t)
    where f :: t -> PatchTarget p
f = (t -> PatchTarget p) -> t -> PatchTarget p
forall t a. HasTrie t => (t -> a) -> t -> a
memo ((t -> PatchTarget p) -> t -> PatchTarget p)
-> (t -> PatchTarget p) -> t -> PatchTarget p
forall a b. (a -> b) -> a -> b
$ \t
sampleTime ->
            -- Really, the sampleTime should never be prior to the initialTime,
            -- because that would mean the Behavior is being sampled before
            -- being created.
            if t
sampleTime t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
initialTime
            then PatchTarget p
initialValue
            else let lastTime :: t
lastTime = t -> t
forall a. Enum a => a -> a
pred t
sampleTime
                     lastValue :: PatchTarget p
lastValue = t -> PatchTarget p
f t
lastTime
                 in case Event (Pure t) p -> t -> Maybe p
forall t a. Event (Pure t) a -> t -> Maybe a
unEvent Event (Pure t) p
e t
lastTime of
                   Maybe p
Nothing -> PatchTarget p
lastValue
                   Just p
x -> PatchTarget p -> Maybe (PatchTarget p) -> PatchTarget p
forall a. a -> Maybe a -> a
fromMaybe PatchTarget p
lastValue (Maybe (PatchTarget p) -> PatchTarget p)
-> Maybe (PatchTarget p) -> PatchTarget p
forall a b. (a -> b) -> a -> b
$ p -> PatchTarget p -> Maybe (PatchTarget p)
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply p
x PatchTarget p
lastValue

  headE :: Event (Pure t) a -> t -> Event (Pure t) a
headE = Event (Pure t) a -> t -> Event (Pure t) a
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m) =>
Event t a -> m (Event t a)
slowHeadE
  now :: t -> Event (Pure t) ()
now t
t = (t -> Maybe ()) -> Event (Pure t) ()
forall t a. (t -> Maybe a) -> Event (Pure t) a
Event ((t -> Maybe ()) -> Event (Pure t) ())
-> (t -> Maybe ()) -> Event (Pure t) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (t -> Bool) -> t -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t
t t -> t -> Bool
forall a. Eq a => a -> a -> Bool
==)