{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecursiveDo #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
#ifdef USE_REFLEX_OPTIMIZER
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
#endif
module Reflex.Dynamic
(
Dynamic
, current
, updated
, holdDyn
, mapDynM
, forDynM
, constDyn
, count
, toggle
, switchDyn
, switchPromptlyDyn
, tagPromptlyDyn
, attachPromptlyDyn
, attachPromptlyDynWith
, attachPromptlyDynWithMaybe
, maybeDyn
, eitherDyn
, factorDyn
, scanDyn
, scanDynMaybe
, holdUniqDyn
, holdUniqDynBy
, improvingMaybe
, foldDyn
, foldDynM
, foldDynMaybe
, foldDynMaybeM
, joinDynThroughMap
, joinDynThroughIntMap
, traceDyn
, traceDynWith
, splitDynPure
, distributeMapOverDynPure
, distributeIntMapOverDynPure
, distributeDMapOverDynPure
, distributeListOverDynPure
, Demux
, demux
, demuxed
, HList (..)
, FHList (..)
, collectDynPure
, RebuildSortedHList (..)
, IsHList (..)
, AllAreFunctors (..)
, HListPtr (..)
, distributeFHListOverDynPure
, unsafeDynamic
) where
import Data.Functor.Compose
import Data.Functor.Misc
import Reflex.Class
import Control.Monad
import Control.Monad.Fix
import Control.Monad.Identity
import Data.Align
import Data.Dependent.Map (DMap)
import qualified Data.Dependent.Map as DMap
import Data.Dependent.Sum (DSum (..))
import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Kind (Type)
import Data.Map (Map)
import Data.Maybe
import Data.Monoid ((<>))
import Data.These
import Data.Type.Equality ((:~:) (..))
import Debug.Trace
mapDynM :: forall t m a b. (Reflex t, MonadHold t m) => (forall m'. MonadSample t m' => a -> m' b) -> Dynamic t a -> m (Dynamic t b)
mapDynM :: (forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> Dynamic t a -> m (Dynamic t b)
mapDynM forall (m' :: * -> *). MonadSample t m' => a -> m' b
f Dynamic t a
d = PushM t b -> Event t b -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (a -> PushM t b
forall (m' :: * -> *). MonadSample t m' => a -> m' b
f (a -> PushM t b) -> PushM t a -> PushM t b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d)) (Event t b -> m (Dynamic t b)) -> Event t b -> m (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ (a -> PushM t b) -> Event t a -> Event t b
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t b) -> Event t a -> Event t b
pushAlways a -> PushM t b
forall (m' :: * -> *). MonadSample t m' => a -> m' b
f (Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d)
forDynM :: forall t m a b. (Reflex t, MonadHold t m) => Dynamic t a -> (forall m'. MonadSample t m' => a -> m' b) -> m (Dynamic t b)
forDynM :: Dynamic t a
-> (forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> m (Dynamic t b)
forDynM Dynamic t a
d forall (m' :: * -> *). MonadSample t m' => a -> m' b
f = (forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> Dynamic t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m) =>
(forall (m' :: * -> *). MonadSample t m' => a -> m' b)
-> Dynamic t a -> m (Dynamic t b)
mapDynM forall (m' :: * -> *). MonadSample t m' => a -> m' b
f Dynamic t a
d
holdUniqDyn :: (Reflex t, MonadHold t m, MonadFix m, Eq a) => Dynamic t a -> m (Dynamic t a)
holdUniqDyn :: Dynamic t a -> m (Dynamic t a)
holdUniqDyn = (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
holdUniqDynBy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
holdUniqDynBy :: (Reflex t, MonadHold t m, MonadFix m) => (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
holdUniqDynBy :: (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)
holdUniqDynBy a -> a -> Bool
eq = (a -> a) -> (a -> a -> Maybe a) -> Dynamic t a -> m (Dynamic t a)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe a -> a
forall a. a -> a
id (\a
new a
old -> if a
new a -> a -> Bool
`eq` a
old then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
new)
improvingMaybe :: (Reflex t, MonadHold t m, MonadFix m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))
improvingMaybe :: Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))
improvingMaybe = (Maybe a -> Maybe a)
-> (Maybe a -> Maybe a -> Maybe (Maybe a))
-> Dynamic t (Maybe a)
-> m (Dynamic t (Maybe a))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe Maybe a -> Maybe a
forall a. a -> a
id (\Maybe a
new Maybe a
_ -> if Maybe a -> Bool
forall a. Maybe a -> Bool
isJust Maybe a
new then Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
new else Maybe (Maybe a)
forall a. Maybe a
Nothing)
scanDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)
scanDyn :: (a -> b) -> (a -> b -> b) -> Dynamic t a -> m (Dynamic t b)
scanDyn a -> b
z a -> b -> b
f = (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe a -> b
z (\a
a b
b -> b -> Maybe b
forall a. a -> Maybe a
Just (b -> Maybe b) -> b -> Maybe b
forall a b. (a -> b) -> a -> b
$ a -> b -> b
f a
a b
b)
scanDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe :: (a -> b) -> (a -> b -> Maybe b) -> Dynamic t a -> m (Dynamic t b)
scanDynMaybe a -> b
z a -> b -> Maybe b
f Dynamic t a
d = do
rec Dynamic t b
d' <- PushM t b -> Event t b -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (a -> b
z (a -> b) -> PushM t a -> PushM t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d)) (Event t b -> m (Dynamic t b)) -> Event t b -> m (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ ((a -> PushM t (Maybe b)) -> Event t a -> Event t b)
-> Event t a -> (a -> PushM t (Maybe b)) -> Event t b
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> PushM t (Maybe b)) -> Event t a -> Event t b
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push (Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d) ((a -> PushM t (Maybe b)) -> Event t b)
-> (a -> PushM t (Maybe b)) -> Event t b
forall a b. (a -> b) -> a -> b
$ \a
a -> do
b
b <- Behavior t b -> PushM t b
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t b -> PushM t b) -> Behavior t b -> PushM t b
forall a b. (a -> b) -> a -> b
$ Dynamic t b -> Behavior t b
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t b
d'
Maybe b -> PushM t (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> PushM t (Maybe b)) -> Maybe b -> PushM t (Maybe b)
forall a b. (a -> b) -> a -> b
$ a -> b -> Maybe b
f a
a b
b
Dynamic t b -> m (Dynamic t b)
forall (m :: * -> *) a. Monad m => a -> m a
return Dynamic t b
d'
foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn :: (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn = (b -> a -> b) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> a) -> a -> Event t b -> m (Dynamic t a)
accumDyn ((b -> a -> b) -> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> b) -> b -> a -> b)
-> (a -> b -> b)
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> b) -> b -> a -> b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
foldDynM :: (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
foldDynM = (b -> a -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)
accumMDyn ((b -> a -> PushM t b) -> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> PushM t b) -> b -> a -> PushM t b)
-> (a -> b -> PushM t b)
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> PushM t b) -> b -> a -> PushM t b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybe :: (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybe = (b -> a -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)
accumMaybeDyn ((b -> a -> Maybe b) -> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> Maybe b) -> b -> a -> Maybe b)
-> (a -> b -> Maybe b)
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> Maybe b) -> b -> a -> Maybe b
forall a b c. (a -> b -> c) -> b -> a -> c
flip
foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybeM :: (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
foldDynMaybeM = (b -> a -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)
accumMaybeMDyn ((b -> a -> PushM t (Maybe b))
-> b -> Event t a -> m (Dynamic t b))
-> ((a -> b -> PushM t (Maybe b)) -> b -> a -> PushM t (Maybe b))
-> (a -> b -> PushM t (Maybe b))
-> b
-> Event t a
-> m (Dynamic t b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b -> PushM t (Maybe b)) -> b -> a -> PushM t (Maybe b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip
count :: (Reflex t, MonadHold t m, MonadFix m, Num b) => Event t a -> m (Dynamic t b)
count :: Event t a -> m (Dynamic t b)
count Event t a
e = b -> Event t b -> m (Dynamic t b)
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn b
0 (Event t b -> m (Dynamic t b)) -> m (Event t b) -> m (Dynamic t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (b -> a -> b) -> [b] -> Event t a -> m (Event t b)
forall k (t :: k) (m :: * -> *) a b c.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> c) -> [a] -> Event t b -> m (Event t c)
zipListWithEvent b -> a -> b
forall a b. a -> b -> a
const ((b -> b) -> b -> [b]
forall a. (a -> a) -> a -> [a]
iterate (b -> b -> b
forall a. Num a => a -> a -> a
+b
1) b
1) Event t a
e
toggle :: (Reflex t, MonadHold t m, MonadFix m) => Bool -> Event t a -> m (Dynamic t Bool)
toggle :: Bool -> Event t a -> m (Dynamic t Bool)
toggle = (a -> Bool -> Bool) -> Bool -> Event t a -> m (Dynamic t Bool)
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn ((Bool -> Bool) -> a -> Bool -> Bool
forall a b. a -> b -> a
const Bool -> Bool
not)
switchDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
switchDyn :: Dynamic t (Event t a) -> Event t a
switchDyn Dynamic t (Event t a)
d = Behavior t (Event t a) -> Event t a
forall k (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Dynamic t (Event t a) -> Behavior t (Event t a)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Event t a)
d)
switchPromptlyDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a
switchPromptlyDyn :: Dynamic t (Event t a) -> Event t a
switchPromptlyDyn Dynamic t (Event t a)
de =
let eLag :: Event t a
eLag = Behavior t (Event t a) -> Event t a
forall k (t :: k) a.
Reflex t =>
Behavior t (Event t a) -> Event t a
switch (Behavior t (Event t a) -> Event t a)
-> Behavior t (Event t a) -> Event t a
forall a b. (a -> b) -> a -> b
$ Dynamic t (Event t a) -> Behavior t (Event t a)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (Event t a)
de
eCoincidences :: Event t a
eCoincidences = Event t (Event t a) -> Event t a
forall k (t :: k) a. Reflex t => Event t (Event t a) -> Event t a
coincidence (Event t (Event t a) -> Event t a)
-> Event t (Event t a) -> Event t a
forall a b. (a -> b) -> a -> b
$ Dynamic t (Event t a) -> Event t (Event t a)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (Event t a)
de
in [Event t a] -> Event t a
forall k (t :: k) a. Reflex t => [Event t a] -> Event t a
leftmost [Event t a
eCoincidences, Event t a
eLag]
splitDynPure :: Reflex t => Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
splitDynPure :: Dynamic t (a, b) -> (Dynamic t a, Dynamic t b)
splitDynPure Dynamic t (a, b)
d = (((a, b) -> a) -> Dynamic t (a, b) -> Dynamic t a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> a
forall a b. (a, b) -> a
fst Dynamic t (a, b)
d, ((a, b) -> b) -> Dynamic t (a, b) -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a, b) -> b
forall a b. (a, b) -> b
snd Dynamic t (a, b)
d)
distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)
distributeMapOverDynPure :: Map k (Dynamic t v) -> Dynamic t (Map k v)
distributeMapOverDynPure = (DMap (Const2 k v) Identity -> Map k v)
-> Dynamic t (DMap (Const2 k v) Identity) -> Dynamic t (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap (Const2 k v) Identity -> Map k v
forall k v. DMap (Const2 k v) Identity -> Map k v
dmapToMap (Dynamic t (DMap (Const2 k v) Identity) -> Dynamic t (Map k v))
-> (Map k (Dynamic t v) -> Dynamic t (DMap (Const2 k v) Identity))
-> Map k (Dynamic t v)
-> Dynamic t (Map k v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap (Const2 k v) (Dynamic t)
-> Dynamic t (DMap (Const2 k v) Identity)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
DMap k2 (Dynamic t) -> Dynamic t (DMap k2 Identity)
distributeDMapOverDynPure (DMap (Const2 k v) (Dynamic t)
-> Dynamic t (DMap (Const2 k v) Identity))
-> (Map k (Dynamic t v) -> DMap (Const2 k v) (Dynamic t))
-> Map k (Dynamic t v)
-> Dynamic t (DMap (Const2 k v) Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k (Dynamic t v) -> DMap (Const2 k v) (Dynamic t)
forall k1 k2 (f :: k1 -> *) (v :: k1).
Map k2 (f v) -> DMap (Const2 k2 v) f
mapWithFunctorToDMap
distributeIntMapOverDynPure :: (Reflex t) => IntMap (Dynamic t v) -> Dynamic t (IntMap v)
distributeIntMapOverDynPure :: IntMap (Dynamic t v) -> Dynamic t (IntMap v)
distributeIntMapOverDynPure = (DMap (Const2 Key v) Identity -> IntMap v)
-> Dynamic t (DMap (Const2 Key v) Identity) -> Dynamic t (IntMap v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap (Const2 Key v) Identity -> IntMap v
forall v. DMap (Const2 Key v) Identity -> IntMap v
dmapToIntMap (Dynamic t (DMap (Const2 Key v) Identity) -> Dynamic t (IntMap v))
-> (IntMap (Dynamic t v)
-> Dynamic t (DMap (Const2 Key v) Identity))
-> IntMap (Dynamic t v)
-> Dynamic t (IntMap v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap (Const2 Key v) (Dynamic t)
-> Dynamic t (DMap (Const2 Key v) Identity)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
DMap k2 (Dynamic t) -> Dynamic t (DMap k2 Identity)
distributeDMapOverDynPure (DMap (Const2 Key v) (Dynamic t)
-> Dynamic t (DMap (Const2 Key v) Identity))
-> (IntMap (Dynamic t v) -> DMap (Const2 Key v) (Dynamic t))
-> IntMap (Dynamic t v)
-> Dynamic t (DMap (Const2 Key v) Identity)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap (Dynamic t v) -> DMap (Const2 Key v) (Dynamic t)
forall k (f :: k -> *) (v :: k).
IntMap (f v) -> DMap (Const2 Key v) f
intMapWithFunctorToDMap
{-# DEPRECATED distributeListOverDynPure "Use 'distributeListOverDyn' instead" #-}
distributeListOverDynPure :: Reflex t => [Dynamic t v] -> Dynamic t [v]
distributeListOverDynPure :: [Dynamic t v] -> Dynamic t [v]
distributeListOverDynPure = [Dynamic t v] -> Dynamic t [v]
forall k (t :: k) a. Reflex t => [Dynamic t a] -> Dynamic t [a]
distributeListOverDyn
joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
joinDynThroughMap :: Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
joinDynThroughMap = (Map k (Dynamic t a) -> Dynamic t (Map k a)
forall k (t :: k) k v.
(Reflex t, Ord k) =>
Map k (Dynamic t v) -> Dynamic t (Map k v)
distributeMapOverDynPure (Map k (Dynamic t a) -> Dynamic t (Map k a))
-> Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
joinDynThroughIntMap :: forall t a. (Reflex t) => Dynamic t (IntMap (Dynamic t a)) -> Dynamic t (IntMap a)
joinDynThroughIntMap :: Dynamic t (IntMap (Dynamic t a)) -> Dynamic t (IntMap a)
joinDynThroughIntMap = (IntMap (Dynamic t a) -> Dynamic t (IntMap a)
forall k (t :: k) v.
Reflex t =>
IntMap (Dynamic t v) -> Dynamic t (IntMap v)
distributeIntMapOverDynPure (IntMap (Dynamic t a) -> Dynamic t (IntMap a))
-> Dynamic t (IntMap (Dynamic t a)) -> Dynamic t (IntMap a)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<)
traceDyn :: (Reflex t, Show a) => String -> Dynamic t a -> Dynamic t a
traceDyn :: String -> Dynamic t a -> Dynamic t a
traceDyn String
s = (a -> String) -> Dynamic t a -> Dynamic t a
forall k (t :: k) a.
Reflex t =>
(a -> String) -> Dynamic t a -> Dynamic t a
traceDynWith ((a -> String) -> Dynamic t a -> Dynamic t a)
-> (a -> String) -> Dynamic t a -> Dynamic t a
forall a b. (a -> b) -> a -> b
$ \a
x -> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
x
traceDynWith :: Reflex t => (a -> String) -> Dynamic t a -> Dynamic t a
traceDynWith :: (a -> String) -> Dynamic t a -> Dynamic t a
traceDynWith a -> String
f Dynamic t a
d =
let e' :: Event t a
e' = (a -> String) -> Event t a -> Event t a
forall k (t :: k) a.
Reflex t =>
(a -> String) -> Event t a -> Event t a
traceEventWith a -> String
f (Event t a -> Event t a) -> Event t a -> Event t a
forall a b. (a -> b) -> a -> b
$ Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d
getV0 :: PullM t a
getV0 = do
a
x <- Behavior t a -> PullM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t a -> PullM t a) -> Behavior t a -> PullM t a
forall a b. (a -> b) -> a -> b
$ Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d
String -> PullM t a -> PullM t a
forall a. String -> a -> a
trace (a -> String
f a
x) (PullM t a -> PullM t a) -> PullM t a -> PullM t a
forall a b. (a -> b) -> a -> b
$ a -> PullM t a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
in PullM t a -> Event t a -> Dynamic t a
forall k (t :: k) a.
Reflex t =>
PullM t a -> Event t a -> Dynamic t a
unsafeBuildDynamic PullM t a
getV0 Event t a
e'
tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a
tagPromptlyDyn :: Dynamic t a -> Event t b -> Event t a
tagPromptlyDyn = (a -> b -> a) -> Dynamic t a -> Event t b -> Event t a
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith a -> b -> a
forall a b. a -> b -> a
const
attachPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)
attachPromptlyDyn :: Dynamic t a -> Event t b -> Event t (a, b)
attachPromptlyDyn = (a -> b -> (a, b)) -> Dynamic t a -> Event t b -> Event t (a, b)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith (,)
attachPromptlyDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith :: (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWith a -> b -> c
f = (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWithMaybe ((a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c)
-> (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
forall a b. (a -> b) -> a -> b
$ \a
a b
b -> c -> Maybe c
forall a. a -> Maybe a
Just (c -> Maybe c) -> c -> Maybe c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
a b
b
attachPromptlyDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWithMaybe :: (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c
attachPromptlyDynWithMaybe a -> b -> Maybe c
f Dynamic t a
d Event t b
e =
let e' :: Event t (a, b)
e' = Behavior t a -> Event t b -> Event t (a, b)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t a -> Behavior t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t a
d) Event t b
e
in Event t (These (a, b) a)
-> (These (a, b) a -> Maybe c) -> Event t c
forall (f :: * -> *) a b.
Filterable f =>
f a -> (a -> Maybe b) -> f b
fforMaybe (Event t (a, b) -> Event t a -> Event t (These (a, b) a)
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align Event t (a, b)
e' (Event t a -> Event t (These (a, b) a))
-> Event t a -> Event t (These (a, b) a)
forall a b. (a -> b) -> a -> b
$ Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
d) ((These (a, b) a -> Maybe c) -> Event t c)
-> (These (a, b) a -> Maybe c) -> Event t c
forall a b. (a -> b) -> a -> b
$ \case
This (a
a, b
b) -> a -> b -> Maybe c
f a
a b
b
These (a
_, b
b) a
a -> a -> b -> Maybe c
f a
a b
b
That a
_ -> Maybe c
forall a. Maybe a
Nothing
maybeDyn :: forall t a m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn :: Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn = (Dynamic t (Either (Dynamic t ()) (Dynamic t a))
-> Dynamic t (Maybe (Dynamic t a)))
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
-> m (Dynamic t (Maybe (Dynamic t a)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either (Dynamic t ()) (Dynamic t a) -> Maybe (Dynamic t a))
-> Dynamic t (Either (Dynamic t ()) (Dynamic t a))
-> Dynamic t (Maybe (Dynamic t a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either (Dynamic t ()) (Dynamic t a) -> Maybe (Dynamic t a)
forall a a. Either a a -> Maybe a
unpack) (m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
-> m (Dynamic t (Maybe (Dynamic t a))))
-> (Dynamic t (Maybe a)
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a))))
-> Dynamic t (Maybe a)
-> m (Dynamic t (Maybe (Dynamic t a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t (Either () a)
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
forall k (t :: k) a b (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Dynamic t (Either a b)
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
eitherDyn (Dynamic t (Either () a)
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a))))
-> (Dynamic t (Maybe a) -> Dynamic t (Either () a))
-> Dynamic t (Maybe a)
-> m (Dynamic t (Either (Dynamic t ()) (Dynamic t a)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe a -> Either () a)
-> Dynamic t (Maybe a) -> Dynamic t (Either () a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe a -> Either () a
forall b. Maybe b -> Either () b
pack
where pack :: Maybe b -> Either () b
pack = \case
Maybe b
Nothing -> () -> Either () b
forall a b. a -> Either a b
Left ()
Just b
a -> b -> Either () b
forall a b. b -> Either a b
Right b
a
unpack :: Either a a -> Maybe a
unpack = \case
Left a
_ -> Maybe a
forall a. Maybe a
Nothing
Right a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
eitherDyn :: forall t a b m. (Reflex t, MonadFix m, MonadHold t m) => Dynamic t (Either a b) -> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
eitherDyn :: Dynamic t (Either a b)
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
eitherDyn = (Dynamic t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))
-> Dynamic t (Either (Dynamic t a) (Dynamic t b)))
-> m (Dynamic
t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((DSum (EitherTag a b) (Compose (Dynamic t) Identity)
-> Either (Dynamic t a) (Dynamic t b))
-> Dynamic t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))
-> Dynamic t (Either (Dynamic t a) (Dynamic t b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DSum (EitherTag a b) (Compose (Dynamic t) Identity)
-> Either (Dynamic t a) (Dynamic t b)
unpack) (m (Dynamic
t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b))))
-> (Dynamic t (Either a b)
-> m (Dynamic
t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))))
-> Dynamic t (Either a b)
-> m (Dynamic t (Either (Dynamic t a) (Dynamic t b)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t (DSum (EitherTag a b) Identity)
-> m (Dynamic
t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
forall k k1 (t :: k) (m :: * -> *) (k :: k1 -> *) (v :: k1 -> *).
(Reflex t, MonadHold t m, GEq k) =>
Dynamic t (DSum k v)
-> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
factorDyn (Dynamic t (DSum (EitherTag a b) Identity)
-> m (Dynamic
t (DSum (EitherTag a b) (Compose (Dynamic t) Identity))))
-> (Dynamic t (Either a b)
-> Dynamic t (DSum (EitherTag a b) Identity))
-> Dynamic t (Either a b)
-> m (Dynamic
t (DSum (EitherTag a b) (Compose (Dynamic t) Identity)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either a b -> DSum (EitherTag a b) Identity)
-> Dynamic t (Either a b)
-> Dynamic t (DSum (EitherTag a b) Identity)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either a b -> DSum (EitherTag a b) Identity
forall a b. Either a b -> DSum (EitherTag a b) Identity
eitherToDSum
where unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity) -> Either (Dynamic t a) (Dynamic t b)
unpack :: DSum (EitherTag a b) (Compose (Dynamic t) Identity)
-> Either (Dynamic t a) (Dynamic t b)
unpack = \case
EitherTag a b a
LeftTag :=> Compose Dynamic t (Identity a)
a -> Dynamic t a -> Either (Dynamic t a) (Dynamic t b)
forall a b. a -> Either a b
Left (Dynamic t a -> Either (Dynamic t a) (Dynamic t b))
-> Dynamic t a -> Either (Dynamic t a) (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Identity a) -> Dynamic t a
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Dynamic t a -> Dynamic t b
coerceDynamic Dynamic t (Identity a)
a
EitherTag a b a
RightTag :=> Compose Dynamic t (Identity a)
b -> Dynamic t b -> Either (Dynamic t a) (Dynamic t b)
forall a b. b -> Either a b
Right (Dynamic t b -> Either (Dynamic t a) (Dynamic t b))
-> Dynamic t b -> Either (Dynamic t a) (Dynamic t b)
forall a b. (a -> b) -> a -> b
$ Dynamic t (Identity a) -> Dynamic t b
forall k (t :: k) a b.
(Reflex t, Coercible a b) =>
Dynamic t a -> Dynamic t b
coerceDynamic Dynamic t (Identity a)
b
factorDyn :: forall t m k v. (Reflex t, MonadHold t m, GEq k)
=> Dynamic t (DSum k v) -> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
factorDyn :: Dynamic t (DSum k v)
-> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
factorDyn Dynamic t (DSum k v)
d = PushM t (DSum k (Compose (Dynamic t) v))
-> Event t (DSum k (Compose (Dynamic t) v))
-> m (Dynamic t (DSum k (Compose (Dynamic t) v)))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
PushM t a -> Event t a -> m (Dynamic t a)
buildDynamic (Behavior t (DSum k v) -> PushM t (DSum k v)
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t (DSum k v) -> Behavior t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (DSum k v)
d) PushM t (DSum k v)
-> (DSum k v -> PushM t (DSum k (Compose (Dynamic t) v)))
-> PushM t (DSum k (Compose (Dynamic t) v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= DSum k v -> PushM t (DSum k (Compose (Dynamic t) v))
holdKey) Event t (DSum k (Compose (Dynamic t) v))
update where
update :: Event t (DSum k (Compose (Dynamic t) v))
update :: Event t (DSum k (Compose (Dynamic t) v))
update = ((DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k v) -> Event t (DSum k (Compose (Dynamic t) v)))
-> Event t (DSum k v)
-> (DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k (Compose (Dynamic t) v))
forall a b c. (a -> b -> c) -> b -> a -> c
flip (DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k v) -> Event t (DSum k (Compose (Dynamic t) v))
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push (Dynamic t (DSum k v) -> Event t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (DSum k v)
d) ((DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k (Compose (Dynamic t) v)))
-> (DSum k v -> PushM t (Maybe (DSum k (Compose (Dynamic t) v))))
-> Event t (DSum k (Compose (Dynamic t) v))
forall a b. (a -> b) -> a -> b
$ \(k a
newKey :=> v a
newVal) -> do
(k a
oldKey :=> v a
_) <- Behavior t (DSum k v) -> PushM t (DSum k v)
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Dynamic t (DSum k v) -> Behavior t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (DSum k v)
d)
case k a
newKey k a -> k a -> Maybe (a :~: a)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` k a
oldKey of
Just a :~: a
Refl -> Maybe (DSum k (Compose (Dynamic t) v))
-> PushM t (Maybe (DSum k (Compose (Dynamic t) v)))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (DSum k (Compose (Dynamic t) v))
forall a. Maybe a
Nothing
Maybe (a :~: a)
Nothing -> DSum k (Compose (Dynamic t) v)
-> Maybe (DSum k (Compose (Dynamic t) v))
forall a. a -> Maybe a
Just (DSum k (Compose (Dynamic t) v)
-> Maybe (DSum k (Compose (Dynamic t) v)))
-> PushM t (DSum k (Compose (Dynamic t) v))
-> PushM t (Maybe (DSum k (Compose (Dynamic t) v)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DSum k v -> PushM t (DSum k (Compose (Dynamic t) v))
holdKey (k a
newKey k a -> v a -> DSum k v
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> v a
newVal)
holdKey :: DSum k v -> PushM t (DSum k (Compose (Dynamic t) v))
holdKey (k a
k :=> v a
v) = do
Event t (v a)
inner' <- k a -> Event t (DSum k v) -> PushM t (Event t (v a))
forall k1 k2 (t :: k1) (m :: * -> *) (k3 :: k2 -> *) (v :: k2 -> *)
(a :: k2).
(Reflex t, MonadFix m, MonadHold t m, GEq k3) =>
k3 a -> Event t (DSum k3 v) -> m (Event t (v a))
filterEventKey k a
k (Dynamic t (DSum k v) -> Event t (DSum k v)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (DSum k v)
d)
Dynamic t (v a)
inner <- v a -> Event t (v a) -> PushM t (Dynamic t (v a))
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Dynamic t a)
holdDyn v a
v Event t (v a)
inner'
DSum k (Compose (Dynamic t) v)
-> PushM t (DSum k (Compose (Dynamic t) v))
forall (m :: * -> *) a. Monad m => a -> m a
return (DSum k (Compose (Dynamic t) v)
-> PushM t (DSum k (Compose (Dynamic t) v)))
-> DSum k (Compose (Dynamic t) v)
-> PushM t (DSum k (Compose (Dynamic t) v))
forall a b. (a -> b) -> a -> b
$ k a
k k a -> Compose (Dynamic t) v a -> DSum k (Compose (Dynamic t) v)
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Dynamic t (v a) -> Compose (Dynamic t) v a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose Dynamic t (v a)
inner
data Demux t k = Demux { Demux t k -> Behavior t k
demuxValue :: Behavior t k
, Demux t k -> EventSelector t (Const2 k Bool)
demuxSelector :: EventSelector t (Const2 k Bool)
}
demux :: (Reflex t, Ord k) => Dynamic t k -> Demux t k
demux :: Dynamic t k -> Demux t k
demux Dynamic t k
k = Behavior t k -> EventSelector t (Const2 k Bool) -> Demux t k
forall k (t :: k) k.
Behavior t k -> EventSelector t (Const2 k Bool) -> Demux t k
Demux (Dynamic t k -> Behavior t k
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t k
k)
(Event t (DMap (Const2 k Bool) Identity)
-> EventSelector t (Const2 k Bool)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
Event t (DMap k2 Identity) -> EventSelector t k2
fan (Event t (DMap (Const2 k Bool) Identity)
-> EventSelector t (Const2 k Bool))
-> Event t (DMap (Const2 k Bool) Identity)
-> EventSelector t (Const2 k Bool)
forall a b. (a -> b) -> a -> b
$ (k -> k -> DMap (Const2 k Bool) Identity)
-> Behavior t k
-> Event t k
-> Event t (DMap (Const2 k Bool) Identity)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Behavior t a -> Event t b -> Event t c
attachWith (\k
k0 k
k1 -> if k
k0 k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== k
k1
then DMap (Const2 k Bool) Identity
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f
DMap.empty
else [DSum (Const2 k Bool) Identity] -> DMap (Const2 k Bool) Identity
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList [k -> Const2 k Bool Bool
forall x a (b :: x). a -> Const2 a b b
Const2 k
k0 Const2 k Bool Bool
-> Identity Bool -> DSum (Const2 k Bool) Identity
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Bool -> Identity Bool
forall a. a -> Identity a
Identity Bool
False,
k -> Const2 k Bool Bool
forall x a (b :: x). a -> Const2 a b b
Const2 k
k1 Const2 k Bool Bool
-> Identity Bool -> DSum (Const2 k Bool) Identity
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Bool -> Identity Bool
forall a. a -> Identity a
Identity Bool
True])
(Dynamic t k -> Behavior t k
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t k
k) (Dynamic t k -> Event t k
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t k
k))
demuxed :: (Reflex t, Eq k) => Demux t k -> k -> Dynamic t Bool
demuxed :: Demux t k -> k -> Dynamic t Bool
demuxed Demux t k
d k
k =
let e :: Event t Bool
e = EventSelector t (Const2 k Bool)
-> Const2 k Bool Bool -> Event t Bool
forall k1 (t :: k1) (k2 :: * -> *).
EventSelector t k2 -> forall a. k2 a -> Event t a
select (Demux t k -> EventSelector t (Const2 k Bool)
forall k (t :: k) k. Demux t k -> EventSelector t (Const2 k Bool)
demuxSelector Demux t k
d) (k -> Const2 k Bool Bool
forall x a (b :: x). a -> Const2 a b b
Const2 k
k)
in PullM t Bool -> Event t Bool -> Dynamic t Bool
forall k (t :: k) a.
Reflex t =>
PullM t a -> Event t a -> Dynamic t a
unsafeBuildDynamic ((k -> Bool) -> PullM t k -> PullM t Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (k -> k -> Bool
forall a. Eq a => a -> a -> Bool
==k
k) (PullM t k -> PullM t Bool) -> PullM t k -> PullM t Bool
forall a b. (a -> b) -> a -> b
$ Behavior t k -> PullM t k
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t k -> PullM t k) -> Behavior t k -> PullM t k
forall a b. (a -> b) -> a -> b
$ Demux t k -> Behavior t k
forall k (t :: k) k. Demux t k -> Behavior t k
demuxValue Demux t k
d) Event t Bool
e
data HList (l::[Type]) where
HNil :: HList '[]
HCons :: e -> HList l -> HList (e ': l)
infixr 2 `HCons`
type family HRevApp (l1 :: [k]) (l2 :: [k]) :: [k]
type instance HRevApp '[] l = l
type instance HRevApp (e ': l) l' = HRevApp l (e ': l')
hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp :: HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp HList l1
HNil HList l2
l = HList l2
HList (HRevApp l1 l2)
l
hRevApp (HCons e
x HList l
l) HList l2
l' = HList l -> HList (e : l2) -> HList (HRevApp l (e : l2))
forall (l1 :: [*]) (l2 :: [*]).
HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp HList l
l (e -> HList l2 -> HList (e : l2)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons e
x HList l2
l')
hReverse :: HList l -> HList (HRevApp l '[])
hReverse :: HList l -> HList (HRevApp l '[])
hReverse HList l
l = HList l -> HList '[] -> HList (HRevApp l '[])
forall (l1 :: [*]) (l2 :: [*]).
HList l1 -> HList l2 -> HList (HRevApp l1 l2)
hRevApp HList l
l HList '[]
HNil
hBuild :: (HBuild' '[] r) => r
hBuild :: r
hBuild = HList '[] -> r
forall (l :: [*]) r. HBuild' l r => HList l -> r
hBuild' HList '[]
HNil
class HBuild' l r where
hBuild' :: HList l -> r
instance (l' ~ HRevApp l '[])
=> HBuild' l (HList l') where
hBuild' :: HList l -> HList l'
hBuild' = HList l -> HList l'
forall (l :: [*]). HList l -> HList (HRevApp l '[])
hReverse
instance HBuild' (a ': l) r
=> HBuild' l (a->r) where
hBuild' :: HList l -> a -> r
hBuild' HList l
l a
x = HList (a : l) -> r
forall (l :: [*]) r. HBuild' l r => HList l -> r
hBuild' (a -> HList l -> HList (a : l)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons a
x HList l
l)
data FHList f l where
FHNil :: FHList f '[]
FHCons :: f e -> FHList f l -> FHList f (e ': l)
instance GEq (HListPtr l) where
HListPtr l a
HHeadPtr geq :: HListPtr l a -> HListPtr l b -> Maybe (a :~: b)
`geq` HListPtr l b
HHeadPtr = (a :~: a) -> Maybe (a :~: a)
forall a. a -> Maybe a
Just a :~: a
forall k (a :: k). a :~: a
Refl
HListPtr l a
HHeadPtr `geq` HTailPtr HListPtr t b
_ = Maybe (a :~: b)
forall a. Maybe a
Nothing
HTailPtr HListPtr t a
_ `geq` HListPtr l b
HHeadPtr = Maybe (a :~: b)
forall a. Maybe a
Nothing
HTailPtr HListPtr t a
a `geq` HTailPtr HListPtr t b
b = HListPtr t a
a HListPtr t a -> HListPtr t b -> Maybe (a :~: b)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` HListPtr t b
HListPtr t b
b
instance GCompare (HListPtr l) where
HListPtr l a
HHeadPtr gcompare :: HListPtr l a -> HListPtr l b -> GOrdering a b
`gcompare` HListPtr l b
HHeadPtr = GOrdering a b
forall k (a :: k). GOrdering a a
GEQ
HListPtr l a
HHeadPtr `gcompare` HTailPtr HListPtr t b
_ = GOrdering a b
forall k (a :: k) (b :: k). GOrdering a b
GLT
HTailPtr HListPtr t a
_ `gcompare` HListPtr l b
HHeadPtr = GOrdering a b
forall k (a :: k) (b :: k). GOrdering a b
GGT
HTailPtr HListPtr t a
a `gcompare` HTailPtr HListPtr t b
b = HListPtr t a
a HListPtr t a -> HListPtr t b -> GOrdering a b
forall k (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> GOrdering a b
`gcompare` HListPtr t b
HListPtr t b
b
data HListPtr l a where
HHeadPtr :: HListPtr (h ': t) h
HTailPtr :: HListPtr t a -> HListPtr (h ': t) a
deriving instance Eq (HListPtr l a)
deriving instance Ord (HListPtr l a)
fhlistToDMap :: forall (f :: Type -> Type) l. FHList f l -> DMap (HListPtr l) f
fhlistToDMap :: FHList f l -> DMap (HListPtr l) f
fhlistToDMap = [DSum (HListPtr l) f] -> DMap (HListPtr l) f
forall k1 (k2 :: k1 -> *) (f :: k1 -> *).
GCompare k2 =>
[DSum k2 f] -> DMap k2 f
DMap.fromList ([DSum (HListPtr l) f] -> DMap (HListPtr l) f)
-> (FHList f l -> [DSum (HListPtr l) f])
-> FHList f l
-> DMap (HListPtr l) f
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FHList f l -> [DSum (HListPtr l) f]
forall (l' :: [*]). FHList f l' -> [DSum (HListPtr l') f]
go
where go :: forall l'. FHList f l' -> [DSum (HListPtr l') f]
go :: FHList f l' -> [DSum (HListPtr l') f]
go = \case
FHList f l'
FHNil -> []
FHCons f e
h FHList f l
t -> (HListPtr (e : l) e
forall a (h :: a) (t :: [a]). HListPtr (h : t) h
HHeadPtr HListPtr (e : l) e -> f e -> DSum (HListPtr (e : l)) f
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> f e
h) DSum (HListPtr (e : l)) f
-> [DSum (HListPtr (e : l)) f] -> [DSum (HListPtr (e : l)) f]
forall a. a -> [a] -> [a]
: (DSum (HListPtr l) f -> DSum (HListPtr (e : l)) f)
-> [DSum (HListPtr l) f] -> [DSum (HListPtr (e : l)) f]
forall a b. (a -> b) -> [a] -> [b]
map (\(HListPtr l a
p :=> f a
v) -> HListPtr l a -> HListPtr (e : l) a
forall a (t :: [a]) (a :: a) (h :: a).
HListPtr t a -> HListPtr (h : t) a
HTailPtr HListPtr l a
p HListPtr (e : l) a -> f a -> DSum (HListPtr (e : l)) f
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> f a
v) (FHList f l -> [DSum (HListPtr l) f]
forall (l' :: [*]). FHList f l' -> [DSum (HListPtr l') f]
go FHList f l
t)
class RebuildSortedHList l where
rebuildSortedFHList :: [DSum (HListPtr l) f] -> FHList f l
rebuildSortedHList :: [DSum (HListPtr l) Identity] -> HList l
instance RebuildSortedHList '[] where
rebuildSortedFHList :: [DSum (HListPtr '[]) f] -> FHList f '[]
rebuildSortedFHList [DSum (HListPtr '[]) f]
l = case [DSum (HListPtr '[]) f]
l of
[] -> FHList f '[]
forall a (f :: a -> *). FHList f '[]
FHNil
DSum (HListPtr '[]) f
_ : [DSum (HListPtr '[]) f]
_ -> String -> FHList f '[]
forall a. HasCallStack => String -> a
error String
"rebuildSortedFHList{'[]}: empty list expected"
rebuildSortedHList :: [DSum (HListPtr '[]) Identity] -> HList '[]
rebuildSortedHList [DSum (HListPtr '[]) Identity]
l = case [DSum (HListPtr '[]) Identity]
l of
[] -> HList '[]
HNil
DSum (HListPtr '[]) Identity
_ : [DSum (HListPtr '[]) Identity]
_ -> String -> HList '[]
forall a. HasCallStack => String -> a
error String
"rebuildSortedHList{'[]}: empty list expected"
instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
rebuildSortedFHList :: [DSum (HListPtr (h : t)) f] -> FHList f (h : t)
rebuildSortedFHList [DSum (HListPtr (h : t)) f]
l = case [DSum (HListPtr (h : t)) f]
l of
((HListPtr (h : t) a
HHeadPtr :=> f a
h) : [DSum (HListPtr (h : t)) f]
t) -> f a -> FHList f t -> FHList f (a : t)
forall a (f :: a -> *) (e :: a) (l :: [a]).
f e -> FHList f l -> FHList f (e : l)
FHCons f a
h (FHList f t -> FHList f (a : t))
-> ([DSum (HListPtr (h : t)) f] -> FHList f t)
-> [DSum (HListPtr (h : t)) f]
-> FHList f (a : t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DSum (HListPtr t) f] -> FHList f t
forall (l :: [*]) (f :: * -> *).
RebuildSortedHList l =>
[DSum (HListPtr l) f] -> FHList f l
rebuildSortedFHList ([DSum (HListPtr t) f] -> FHList f t)
-> ([DSum (HListPtr (h : t)) f] -> [DSum (HListPtr t) f])
-> [DSum (HListPtr (h : t)) f]
-> FHList f t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DSum (HListPtr (h : t)) f -> DSum (HListPtr t) f)
-> [DSum (HListPtr (h : t)) f] -> [DSum (HListPtr t) f]
forall a b. (a -> b) -> [a] -> [b]
map (\(HTailPtr p :=> f a
v) -> HListPtr t a
p HListPtr t a -> f a -> DSum (HListPtr t) f
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> f a
v) ([DSum (HListPtr (h : t)) f] -> FHList f (a : t))
-> [DSum (HListPtr (h : t)) f] -> FHList f (a : t)
forall a b. (a -> b) -> a -> b
$ [DSum (HListPtr (h : t)) f]
t
[DSum (HListPtr (h : t)) f]
_ -> String -> FHList f (h : t)
forall a. HasCallStack => String -> a
error String
"rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
rebuildSortedHList :: [DSum (HListPtr (h : t)) Identity] -> HList (h : t)
rebuildSortedHList [DSum (HListPtr (h : t)) Identity]
l = case [DSum (HListPtr (h : t)) Identity]
l of
((HListPtr (h : t) a
HHeadPtr :=> Identity a
h) : [DSum (HListPtr (h : t)) Identity]
t) -> a -> HList t -> HList (a : t)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons a
h (HList t -> HList (a : t))
-> ([DSum (HListPtr (h : t)) Identity] -> HList t)
-> [DSum (HListPtr (h : t)) Identity]
-> HList (a : t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [DSum (HListPtr t) Identity] -> HList t
forall (l :: [*]).
RebuildSortedHList l =>
[DSum (HListPtr l) Identity] -> HList l
rebuildSortedHList ([DSum (HListPtr t) Identity] -> HList t)
-> ([DSum (HListPtr (h : t)) Identity]
-> [DSum (HListPtr t) Identity])
-> [DSum (HListPtr (h : t)) Identity]
-> HList t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DSum (HListPtr (h : t)) Identity -> DSum (HListPtr t) Identity)
-> [DSum (HListPtr (h : t)) Identity]
-> [DSum (HListPtr t) Identity]
forall a b. (a -> b) -> [a] -> [b]
map (\(HTailPtr p :=> Identity a
v) -> HListPtr t a
p HListPtr t a -> Identity a -> DSum (HListPtr t) Identity
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Identity a
v) ([DSum (HListPtr (h : t)) Identity] -> HList (a : t))
-> [DSum (HListPtr (h : t)) Identity] -> HList (a : t)
forall a b. (a -> b) -> a -> b
$ [DSum (HListPtr (h : t)) Identity]
t
[DSum (HListPtr (h : t)) Identity]
_ -> String -> HList (h : t)
forall a. HasCallStack => String -> a
error String
"rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) Identity -> HList l
dmapToHList :: DMap (HListPtr l) Identity -> HList l
dmapToHList = [DSum (HListPtr l) Identity] -> HList l
forall (l :: [*]).
RebuildSortedHList l =>
[DSum (HListPtr l) Identity] -> HList l
rebuildSortedHList ([DSum (HListPtr l) Identity] -> HList l)
-> (DMap (HListPtr l) Identity -> [DSum (HListPtr l) Identity])
-> DMap (HListPtr l) Identity
-> HList l
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DMap (HListPtr l) Identity -> [DSum (HListPtr l) Identity]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList
distributeFHListOverDynPure :: (Reflex t, RebuildSortedHList l) => FHList (Dynamic t) l -> Dynamic t (HList l)
distributeFHListOverDynPure :: FHList (Dynamic t) l -> Dynamic t (HList l)
distributeFHListOverDynPure FHList (Dynamic t) l
l = (DMap (HListPtr l) Identity -> HList l)
-> Dynamic t (DMap (HListPtr l) Identity) -> Dynamic t (HList l)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DMap (HListPtr l) Identity -> HList l
forall (l :: [*]).
RebuildSortedHList l =>
DMap (HListPtr l) Identity -> HList l
dmapToHList (Dynamic t (DMap (HListPtr l) Identity) -> Dynamic t (HList l))
-> Dynamic t (DMap (HListPtr l) Identity) -> Dynamic t (HList l)
forall a b. (a -> b) -> a -> b
$ DMap (HListPtr l) (Dynamic t)
-> Dynamic t (DMap (HListPtr l) Identity)
forall k1 (t :: k1) (k2 :: * -> *).
(Reflex t, GCompare k2) =>
DMap k2 (Dynamic t) -> Dynamic t (DMap k2 Identity)
distributeDMapOverDynPure (DMap (HListPtr l) (Dynamic t)
-> Dynamic t (DMap (HListPtr l) Identity))
-> DMap (HListPtr l) (Dynamic t)
-> Dynamic t (DMap (HListPtr l) Identity)
forall a b. (a -> b) -> a -> b
$ FHList (Dynamic t) l -> DMap (HListPtr l) (Dynamic t)
forall (f :: * -> *) (l :: [*]). FHList f l -> DMap (HListPtr l) f
fhlistToDMap FHList (Dynamic t) l
l
class AllAreFunctors (f :: a -> Type) (l :: [a]) where
type FunctorList f l :: [Type]
toFHList :: HList (FunctorList f l) -> FHList f l
fromFHList :: FHList f l -> HList (FunctorList f l)
instance AllAreFunctors f '[] where
type FunctorList f '[] = '[]
toFHList :: HList (FunctorList f '[]) -> FHList f '[]
toFHList HList (FunctorList f '[])
l = case HList (FunctorList f '[])
l of
HList (FunctorList f '[])
HNil -> FHList f '[]
forall a (f :: a -> *). FHList f '[]
FHNil
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
_ -> error "toFHList: impossible"
#endif
fromFHList :: FHList f '[] -> HList (FunctorList f '[])
fromFHList FHList f '[]
FHNil = HList '[]
HList (FunctorList f '[])
HNil
instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
type FunctorList f (h ': t) = f h ': FunctorList f t
toFHList :: HList (FunctorList f (h : t)) -> FHList f (h : t)
toFHList HList (FunctorList f (h : t))
l = case HList (FunctorList f (h : t))
l of
e
a `HCons` HList l
b -> e
f h
a f h -> FHList f t -> FHList f (h : t)
forall a (f :: a -> *) (e :: a) (l :: [a]).
f e -> FHList f l -> FHList f (e : l)
`FHCons` HList (FunctorList f t) -> FHList f t
forall a (f :: a -> *) (l :: [a]).
AllAreFunctors f l =>
HList (FunctorList f l) -> FHList f l
toFHList HList l
HList (FunctorList f t)
b
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
_ -> error "toFHList: impossible"
#endif
fromFHList :: FHList f (h : t) -> HList (FunctorList f (h : t))
fromFHList (f e
a `FHCons` FHList f l
b) = f e
a f e -> HList (FunctorList f t) -> HList (f e : FunctorList f t)
forall e (l :: [*]). e -> HList l -> HList (e : l)
`HCons` FHList f l -> HList (FunctorList f l)
forall a (f :: a -> *) (l :: [a]).
AllAreFunctors f l =>
FHList f l -> HList (FunctorList f l)
fromFHList FHList f l
b
collectDynPure :: ( RebuildSortedHList (HListElems b)
, IsHList a, IsHList b
, AllAreFunctors (Dynamic t) (HListElems b)
, Reflex t
, HListElems a ~ FunctorList (Dynamic t) (HListElems b)
) => a -> Dynamic t b
collectDynPure :: a -> Dynamic t b
collectDynPure a
ds = (HList (HListElems b) -> b)
-> Dynamic t (HList (HListElems b)) -> Dynamic t b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HList (HListElems b) -> b
forall a. IsHList a => HList (HListElems a) -> a
fromHList (Dynamic t (HList (HListElems b)) -> Dynamic t b)
-> Dynamic t (HList (HListElems b)) -> Dynamic t b
forall a b. (a -> b) -> a -> b
$ FHList (Dynamic t) (HListElems b)
-> Dynamic t (HList (HListElems b))
forall k (t :: k) (l :: [*]).
(Reflex t, RebuildSortedHList l) =>
FHList (Dynamic t) l -> Dynamic t (HList l)
distributeFHListOverDynPure (FHList (Dynamic t) (HListElems b)
-> Dynamic t (HList (HListElems b)))
-> FHList (Dynamic t) (HListElems b)
-> Dynamic t (HList (HListElems b))
forall a b. (a -> b) -> a -> b
$ HList (FunctorList (Dynamic t) (HListElems b))
-> FHList (Dynamic t) (HListElems b)
forall a (f :: a -> *) (l :: [a]).
AllAreFunctors f l =>
HList (FunctorList f l) -> FHList f l
toFHList (HList (FunctorList (Dynamic t) (HListElems b))
-> FHList (Dynamic t) (HListElems b))
-> HList (FunctorList (Dynamic t) (HListElems b))
-> FHList (Dynamic t) (HListElems b)
forall a b. (a -> b) -> a -> b
$ a -> HList (HListElems a)
forall a. IsHList a => a -> HList (HListElems a)
toHList a
ds
class IsHList a where
type HListElems a :: [Type]
toHList :: a -> HList (HListElems a)
fromHList :: HList (HListElems a) -> a
instance IsHList (a, b) where
type HListElems (a, b) = [a, b]
toHList :: (a, b) -> HList (HListElems (a, b))
toHList (a
a, b
b) = a -> b -> HList '[a, b]
forall r. HBuild' '[] r => r
hBuild a
a b
b
fromHList :: HList (HListElems (a, b)) -> (a, b)
fromHList HList (HListElems (a, b))
l = case HList (HListElems (a, b))
l of
e
a `HCons` e
b `HCons` HList l
HNil -> (a
e
a, b
e
b)
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
_ -> error "fromHList: impossible"
#endif
instance IsHList (a, b, c, d) where
type HListElems (a, b, c, d) = [a, b, c, d]
toHList :: (a, b, c, d) -> HList (HListElems (a, b, c, d))
toHList (a
a, b
b, c
c, d
d) = a -> b -> c -> d -> HList '[a, b, c, d]
forall r. HBuild' '[] r => r
hBuild a
a b
b c
c d
d
fromHList :: HList (HListElems (a, b, c, d)) -> (a, b, c, d)
fromHList HList (HListElems (a, b, c, d))
l = case HList (HListElems (a, b, c, d))
l of
e
a `HCons` e
b `HCons` e
c `HCons` e
d `HCons` HList l
HNil -> (a
e
a, b
e
b, c
e
c, d
e
d)
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
_ -> error "fromHList: impossible"
#endif
instance IsHList (a, b, c, d, e, f) where
type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
toHList :: (a, b, c, d, e, f) -> HList (HListElems (a, b, c, d, e, f))
toHList (a
a, b
b, c
c, d
d, e
e, f
f) = a -> b -> c -> d -> e -> f -> HList '[a, b, c, d, e, f]
forall r. HBuild' '[] r => r
hBuild a
a b
b c
c d
d e
e f
f
fromHList :: HList (HListElems (a, b, c, d, e, f)) -> (a, b, c, d, e, f)
fromHList HList (HListElems (a, b, c, d, e, f))
l = case HList (HListElems (a, b, c, d, e, f))
l of
e
a `HCons` e
b `HCons` e
c `HCons` e
d `HCons` e
e `HCons` e
f `HCons` HList l
HNil -> (a
e
a, b
e
b, c
e
c, d
e
d, e
e
e, f
e
f)
#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800
_ -> error "fromHList: impossible"
#endif