{-# 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, 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
$ \_ -> Maybe a
forall a. Maybe a
Nothing

  constant :: a -> Behavior (Pure t) a
  constant :: a -> Behavior (Pure t) a
constant x :: 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
$ \_ -> 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 f :: a -> PushM (Pure t) (Maybe b)
f e :: 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
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
>>= \o :: 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 nt :: forall (a :: k). q a -> Event (Pure t) (v a)
nt events :: 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
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 (\_ q :: 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 e :: 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 :: 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
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 b :: 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
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 e :: 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
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
>>= \o :: 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 d :: 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
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 d :: 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
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 readV0 :: PullM (Pure t) a
readV0 v' :: 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
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 readV0 :: PullM (Pure t) (PatchTarget p)
readV0 p :: 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
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 i :: 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
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 i :: 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
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 i :: 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
t ->
    let (old :: PatchTarget p
old, mPatch :: 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
          Nothing -> Maybe (PatchTarget p)
forall a. Maybe a
Nothing
          Just patch :: 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 = 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 = 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 = 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 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 e :: 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
$ \k :: 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
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 nt :: forall (a :: k). q a -> Event (Pure t) (v a)
nt i :: 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
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 (\_ q :: 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 i :: 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
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 (\_ (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 f :: a -> b
f d :: 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
t -> let (cur :: a
cur, upd :: 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
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
$ \_ -> (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
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
          Nothing -> (Maybe b
forall a. Maybe a
Nothing, Maybe b
forall a. Maybe a
Nothing)
          Just nextX :: a
nextX -> let (c :: b
c, u :: 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 initialValue :: a
initialValue e :: Event (Pure t) a
e initialTime :: 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
$ \sampleTime :: 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 v0 :: 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 initialValue :: t -> a
initialValue e :: Event (Pure t) a
e initialTime :: 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 -> (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 initialValue :: PatchTarget p
initialValue e :: Event (Pure t) p
e initialTime :: 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 -> (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
$ \sampleTime :: 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
                   Nothing -> PatchTarget p
lastValue
                   Just x :: 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