{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE StandaloneDeriving #-}

module Reflex.Query.Base
  ( QueryT (..)
  , runQueryT
  , mapQuery
  , mapQueryResult
  , dynWithQueryT
  , withQueryT
  , mapQueryT
  ) where

import Control.Applicative (liftA2)
import Control.Monad.Exception
import Control.Monad.Fix
import Control.Monad.Primitive
import Control.Monad.Reader
import Control.Monad.Ref
import Control.Monad.State.Strict
import Data.Align
import Data.Dependent.Map (DMap, DSum (..))
import qualified Data.Dependent.Map as DMap
import Data.Foldable
import Data.Functor.Compose
import Data.Functor.Misc
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Monoid ((<>))
import qualified Data.Semigroup as S
import Data.Some (Some(Some))
import Data.These

import Reflex.Class
import Reflex.Adjustable.Class
import Reflex.DynamicWriter.Class
import Reflex.EventWriter.Base
import Reflex.EventWriter.Class
import Reflex.Host.Class
import qualified Data.Patch.MapWithMove as MapWithMove
import Reflex.PerformEvent.Class
import Reflex.PostBuild.Class
import Reflex.Query.Class
import Reflex.Requester.Class
import Reflex.TriggerEvent.Class

newtype QueryT t q m a = QueryT { QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unQueryT :: StateT [Behavior t q] (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m)) a }
  deriving (a -> QueryT t q m b -> QueryT t q m a
(a -> b) -> QueryT t q m a -> QueryT t q m b
(forall a b. (a -> b) -> QueryT t q m a -> QueryT t q m b)
-> (forall a b. a -> QueryT t q m b -> QueryT t q m a)
-> Functor (QueryT t q m)
forall a b. a -> QueryT t q m b -> QueryT t q m a
forall a b. (a -> b) -> QueryT t q m a -> QueryT t q m b
forall t q (m :: * -> *) a b.
Functor m =>
a -> QueryT t q m b -> QueryT t q m a
forall t q (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryT t q m a -> QueryT t q m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> QueryT t q m b -> QueryT t q m a
$c<$ :: forall t q (m :: * -> *) a b.
Functor m =>
a -> QueryT t q m b -> QueryT t q m a
fmap :: (a -> b) -> QueryT t q m a -> QueryT t q m b
$cfmap :: forall t q (m :: * -> *) a b.
Functor m =>
(a -> b) -> QueryT t q m a -> QueryT t q m b
Functor, Functor (QueryT t q m)
a -> QueryT t q m a
Functor (QueryT t q m) =>
(forall a. a -> QueryT t q m a)
-> (forall a b.
    QueryT t q m (a -> b) -> QueryT t q m a -> QueryT t q m b)
-> (forall a b c.
    (a -> b -> c)
    -> QueryT t q m a -> QueryT t q m b -> QueryT t q m c)
-> (forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m b)
-> (forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m a)
-> Applicative (QueryT t q m)
QueryT t q m a -> QueryT t q m b -> QueryT t q m b
QueryT t q m a -> QueryT t q m b -> QueryT t q m a
QueryT t q m (a -> b) -> QueryT t q m a -> QueryT t q m b
(a -> b -> c) -> QueryT t q m a -> QueryT t q m b -> QueryT t q m c
forall a. a -> QueryT t q m a
forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m a
forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m b
forall a b.
QueryT t q m (a -> b) -> QueryT t q m a -> QueryT t q m b
forall a b c.
(a -> b -> c) -> QueryT t q m a -> QueryT t q m b -> QueryT t q m c
forall t q (m :: * -> *). Monad m => Functor (QueryT t q m)
forall t q (m :: * -> *) a. Monad m => a -> QueryT t q m a
forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m a
forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m b
forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m (a -> b) -> QueryT t q m a -> QueryT t q m b
forall t q (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> QueryT t q m a -> QueryT t q m b -> QueryT t q m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: QueryT t q m a -> QueryT t q m b -> QueryT t q m a
$c<* :: forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m a
*> :: QueryT t q m a -> QueryT t q m b -> QueryT t q m b
$c*> :: forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m b
liftA2 :: (a -> b -> c) -> QueryT t q m a -> QueryT t q m b -> QueryT t q m c
$cliftA2 :: forall t q (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> QueryT t q m a -> QueryT t q m b -> QueryT t q m c
<*> :: QueryT t q m (a -> b) -> QueryT t q m a -> QueryT t q m b
$c<*> :: forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m (a -> b) -> QueryT t q m a -> QueryT t q m b
pure :: a -> QueryT t q m a
$cpure :: forall t q (m :: * -> *) a. Monad m => a -> QueryT t q m a
$cp1Applicative :: forall t q (m :: * -> *). Monad m => Functor (QueryT t q m)
Applicative, Applicative (QueryT t q m)
a -> QueryT t q m a
Applicative (QueryT t q m) =>
(forall a b.
 QueryT t q m a -> (a -> QueryT t q m b) -> QueryT t q m b)
-> (forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m b)
-> (forall a. a -> QueryT t q m a)
-> Monad (QueryT t q m)
QueryT t q m a -> (a -> QueryT t q m b) -> QueryT t q m b
QueryT t q m a -> QueryT t q m b -> QueryT t q m b
forall a. a -> QueryT t q m a
forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m b
forall a b.
QueryT t q m a -> (a -> QueryT t q m b) -> QueryT t q m b
forall t q (m :: * -> *). Monad m => Applicative (QueryT t q m)
forall t q (m :: * -> *) a. Monad m => a -> QueryT t q m a
forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m b
forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> (a -> QueryT t q m b) -> QueryT t q m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> QueryT t q m a
$creturn :: forall t q (m :: * -> *) a. Monad m => a -> QueryT t q m a
>> :: QueryT t q m a -> QueryT t q m b -> QueryT t q m b
$c>> :: forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m b
>>= :: QueryT t q m a -> (a -> QueryT t q m b) -> QueryT t q m b
$c>>= :: forall t q (m :: * -> *) a b.
Monad m =>
QueryT t q m a -> (a -> QueryT t q m b) -> QueryT t q m b
$cp1Monad :: forall t q (m :: * -> *). Monad m => Applicative (QueryT t q m)
Monad, Monad (QueryT t q m)
e -> QueryT t q m a
Monad (QueryT t q m) =>
(forall e a. Exception e => e -> QueryT t q m a)
-> (forall e a.
    Exception e =>
    QueryT t q m a -> (e -> QueryT t q m a) -> QueryT t q m a)
-> (forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m a)
-> MonadException (QueryT t q m)
QueryT t q m a -> (e -> QueryT t q m a) -> QueryT t q m a
QueryT t q m a -> QueryT t q m b -> QueryT t q m a
forall e a. Exception e => e -> QueryT t q m a
forall e a.
Exception e =>
QueryT t q m a -> (e -> QueryT t q m a) -> QueryT t q m a
forall a b. QueryT t q m a -> QueryT t q m b -> QueryT t q m a
forall t q (m :: * -> *). MonadException m => Monad (QueryT t q m)
forall t q (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> QueryT t q m a
forall t q (m :: * -> *) e a.
(MonadException m, Exception e) =>
QueryT t q m a -> (e -> QueryT t q m a) -> QueryT t q m a
forall t q (m :: * -> *) a b.
MonadException m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m a
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall a b. m a -> m b -> m a)
-> MonadException m
finally :: QueryT t q m a -> QueryT t q m b -> QueryT t q m a
$cfinally :: forall t q (m :: * -> *) a b.
MonadException m =>
QueryT t q m a -> QueryT t q m b -> QueryT t q m a
catch :: QueryT t q m a -> (e -> QueryT t q m a) -> QueryT t q m a
$ccatch :: forall t q (m :: * -> *) e a.
(MonadException m, Exception e) =>
QueryT t q m a -> (e -> QueryT t q m a) -> QueryT t q m a
throw :: e -> QueryT t q m a
$cthrow :: forall t q (m :: * -> *) e a.
(MonadException m, Exception e) =>
e -> QueryT t q m a
$cp1MonadException :: forall t q (m :: * -> *). MonadException m => Monad (QueryT t q m)
MonadException, Monad (QueryT t q m)
Monad (QueryT t q m) =>
(forall a. (a -> QueryT t q m a) -> QueryT t q m a)
-> MonadFix (QueryT t q m)
(a -> QueryT t q m a) -> QueryT t q m a
forall a. (a -> QueryT t q m a) -> QueryT t q m a
forall t q (m :: * -> *). MonadFix m => Monad (QueryT t q m)
forall t q (m :: * -> *) a.
MonadFix m =>
(a -> QueryT t q m a) -> QueryT t q m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
mfix :: (a -> QueryT t q m a) -> QueryT t q m a
$cmfix :: forall t q (m :: * -> *) a.
MonadFix m =>
(a -> QueryT t q m a) -> QueryT t q m a
$cp1MonadFix :: forall t q (m :: * -> *). MonadFix m => Monad (QueryT t q m)
MonadFix, Monad (QueryT t q m)
Monad (QueryT t q m) =>
(forall a. IO a -> QueryT t q m a) -> MonadIO (QueryT t q m)
IO a -> QueryT t q m a
forall a. IO a -> QueryT t q m a
forall t q (m :: * -> *). MonadIO m => Monad (QueryT t q m)
forall t q (m :: * -> *) a. MonadIO m => IO a -> QueryT t q m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> QueryT t q m a
$cliftIO :: forall t q (m :: * -> *) a. MonadIO m => IO a -> QueryT t q m a
$cp1MonadIO :: forall t q (m :: * -> *). MonadIO m => Monad (QueryT t q m)
MonadIO, MonadRef (QueryT t q m)
Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
MonadRef (QueryT t q m) =>
(forall a b.
 Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b)
-> (forall a b.
    Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b)
-> MonadAtomicRef (QueryT t q m)
forall a b. Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
forall t q (m :: * -> *).
MonadAtomicRef m =>
MonadRef (QueryT t q m)
forall t q (m :: * -> *) a b.
MonadAtomicRef m =>
Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
forall (m :: * -> *).
MonadRef m =>
(forall a b. Ref m a -> (a -> (a, b)) -> m b)
-> (forall a b. Ref m a -> (a -> (a, b)) -> m b)
-> MonadAtomicRef m
atomicModifyRef' :: Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
$catomicModifyRef' :: forall t q (m :: * -> *) a b.
MonadAtomicRef m =>
Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
atomicModifyRef :: Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
$catomicModifyRef :: forall t q (m :: * -> *) a b.
MonadAtomicRef m =>
Ref (QueryT t q m) a -> (a -> (a, b)) -> QueryT t q m b
$cp1MonadAtomicRef :: forall t q (m :: * -> *).
MonadAtomicRef m =>
MonadRef (QueryT t q m)
MonadAtomicRef)

deriving instance MonadHold t m => MonadHold t (QueryT t q m)
deriving instance MonadSample t m => MonadSample t (QueryT t q m)

runQueryT :: (MonadFix m, Additive q, Group q, Reflex t) => QueryT t q m a -> Dynamic t (QueryResult q) -> m (a, Incremental t (AdditivePatch q))
runQueryT :: QueryT t q m a
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
runQueryT (QueryT a :: StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
a) qr :: Dynamic t (QueryResult q)
qr = do
  ((r :: a
r, bs :: [Behavior t q]
bs), es :: Event t q
es) <- ReaderT
  (Dynamic t (QueryResult q)) m ((a, [Behavior t q]), Event t q)
-> Dynamic t (QueryResult q) -> m ((a, [Behavior t q]), Event t q)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventWriterT
  t q (ReaderT (Dynamic t (QueryResult q)) m) (a, [Behavior t q])
-> ReaderT
     (Dynamic t (QueryResult q)) m ((a, [Behavior t q]), Event t q)
forall t (m :: * -> *) w a.
(Reflex t, Monad m, Semigroup w) =>
EventWriterT t w m a -> m (a, Event t w)
runEventWriterT (StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> [Behavior t q]
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (a, [Behavior t q])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
a [Behavior t q]
forall a. Monoid a => a
mempty)) Dynamic t (QueryResult q)
qr
  (a, Incremental t (AdditivePatch q))
-> m (a, Incremental t (AdditivePatch q))
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r, PullM t (PatchTarget (AdditivePatch q))
-> Event t (AdditivePatch q) -> Incremental t (AdditivePatch q)
forall k (t :: k) p.
(Reflex t, Patch p) =>
PullM t (PatchTarget p) -> Event t p -> Incremental t p
unsafeBuildIncremental ((q -> Behavior t q -> PullM t q)
-> q -> [Behavior t q] -> PullM t q
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\b :: q
b c :: Behavior t q
c -> (q
b q -> q -> q
forall a. Semigroup a => a -> a -> a
<>) (q -> q) -> PullM t q -> PullM t q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t q -> PullM t q
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t q
c) q
forall a. Monoid a => a
mempty [Behavior t q]
bs) ((q -> AdditivePatch q) -> Event t q -> Event t (AdditivePatch q)
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap q -> AdditivePatch q
forall p. p -> AdditivePatch p
AdditivePatch Event t q
es))

newtype QueryTLoweredResult t q v = QueryTLoweredResult (v, [Behavior t q])

getQueryTLoweredResultValue :: QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue :: QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue (QueryTLoweredResult (v :: v
v, _)) = v
v

getQueryTLoweredResultWritten :: QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten :: QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten (QueryTLoweredResult (_, w :: [Behavior t q]
w)) = [Behavior t q]
w

maskMempty :: (Eq a, Monoid a) => a -> Maybe a
maskMempty :: a -> Maybe a
maskMempty x :: a
x = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall a. Monoid a => a
mempty then Maybe a
forall a. Maybe a
Nothing else a -> Maybe a
forall a. a -> Maybe a
Just a
x

instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t m, Adjustable t m) => Adjustable t (QueryT t q m) where
  runWithReplace :: QueryT t q m a
-> Event t (QueryT t q m b) -> QueryT t q m (a, Event t b)
runWithReplace (QueryT a0 :: StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
a0) a' :: Event t (QueryT t q m b)
a' = do
    ((r0 :: a
r0, bs0 :: [Behavior t q]
bs0), r' :: Event t (b, [Behavior t q])
r') <- StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  ((a, [Behavior t q]), Event t (b, [Behavior t q]))
-> QueryT t q m ((a, [Behavior t q]), Event t (b, [Behavior t q]))
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   ((a, [Behavior t q]), Event t (b, [Behavior t q]))
 -> QueryT t q m ((a, [Behavior t q]), Event t (b, [Behavior t q])))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ((a, [Behavior t q]), Event t (b, [Behavior t q]))
-> QueryT t q m ((a, [Behavior t q]), Event t (b, [Behavior t q]))
forall a b. (a -> b) -> a -> b
$ EventWriterT
  t
  q
  (ReaderT (Dynamic t (QueryResult q)) m)
  ((a, [Behavior t q]), Event t (b, [Behavior t q]))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ((a, [Behavior t q]), Event t (b, [Behavior t q]))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT
   t
   q
   (ReaderT (Dynamic t (QueryResult q)) m)
   ((a, [Behavior t q]), Event t (b, [Behavior t q]))
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      ((a, [Behavior t q]), Event t (b, [Behavior t q])))
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     ((a, [Behavior t q]), Event t (b, [Behavior t q]))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ((a, [Behavior t q]), Event t (b, [Behavior t q]))
forall a b. (a -> b) -> a -> b
$ EventWriterT
  t q (ReaderT (Dynamic t (QueryResult q)) m) (a, [Behavior t q])
-> Event
     t
     (EventWriterT
        t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q]))
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     ((a, [Behavior t q]), Event t (b, [Behavior t q]))
forall t (m :: * -> *) a b.
Adjustable t m =>
m a -> Event t (m b) -> m (a, Event t b)
runWithReplace (StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> [Behavior t q]
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (a, [Behavior t q])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
a0 []) (Event
   t
   (EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q]))
 -> EventWriterT
      t
      q
      (ReaderT (Dynamic t (QueryResult q)) m)
      ((a, [Behavior t q]), Event t (b, [Behavior t q])))
-> Event
     t
     (EventWriterT
        t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q]))
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     ((a, [Behavior t q]), Event t (b, [Behavior t q]))
forall a b. (a -> b) -> a -> b
$ (QueryT t q m b
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q]))
-> Event t (QueryT t q m b)
-> Event
     t
     (EventWriterT
        t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q]))
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap ((StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   b
 -> [Behavior t q]
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q]))
-> [Behavior t q]
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     b
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  b
-> [Behavior t q]
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT [] (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   b
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q]))
-> (QueryT t q m b
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         b)
-> QueryT t q m b
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (b, [Behavior t q])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryT t q m b
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     b
forall t q (m :: * -> *) a.
QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unQueryT) Event t (QueryT t q m b)
a'
    let sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
        sampleBs :: [Behavior t q] -> m' q
sampleBs = (q -> Behavior t q -> m' q) -> q -> [Behavior t q] -> m' q
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\b :: q
b a :: Behavior t q
a -> (q
b q -> q -> q
forall a. Semigroup a => a -> a -> a
<>) (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t q -> m' q
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t q
a) q
forall a. Monoid a => a
mempty
        bs' :: Event t [Behavior t q]
bs' = ((b, [Behavior t q]) -> [Behavior t q])
-> Event t (b, [Behavior t q]) -> Event t [Behavior t q]
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap (b, [Behavior t q]) -> [Behavior t q]
forall a b. (a, b) -> b
snd (Event t (b, [Behavior t q]) -> Event t [Behavior t q])
-> Event t (b, [Behavior t q]) -> Event t [Behavior t q]
forall a b. (a -> b) -> a -> b
$ Event t (b, [Behavior t q])
r'
    Behavior t [Behavior t q]
bbs <- [Behavior t q]
-> Event t [Behavior t q]
-> QueryT t q m (Behavior t [Behavior t q])
forall k (t :: k) (m :: * -> *) a.
MonadHold t m =>
a -> Event t a -> m (Behavior t a)
hold [Behavior t q]
bs0 Event t [Behavior t q]
bs'
    let patches :: Event t q
patches = (([Behavior t q] -> PushM t (Maybe q))
 -> Event t [Behavior t q] -> Event t q)
-> Event t [Behavior t q]
-> ([Behavior t q] -> PushM t (Maybe q))
-> Event t q
forall a b c. (a -> b -> c) -> b -> a -> c
flip ([Behavior t q] -> PushM t (Maybe q))
-> Event t [Behavior t q] -> Event t q
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
pushCheap Event t [Behavior t q]
bs' (([Behavior t q] -> PushM t (Maybe q)) -> Event t q)
-> ([Behavior t q] -> PushM t (Maybe q)) -> Event t q
forall a b. (a -> b) -> a -> b
$ \newBs :: [Behavior t q]
newBs -> do
          [Behavior t q]
oldBs <- Behavior t [Behavior t q] -> PushM t [Behavior t q]
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t [Behavior t q]
bbs
          q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> PushM t q -> PushM t (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (q -> q -> q
forall q. Group q => q -> q -> q
(~~) (q -> q -> q) -> PushM t q -> PushM t (q -> q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> PushM t q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs PushM t (q -> q) -> PushM t q -> PushM t q
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Behavior t q] -> PushM t q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs)
    StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  ()
-> QueryT t q m ()
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   ()
 -> QueryT t q m ())
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
-> QueryT t q m ()
forall a b. (a -> b) -> a -> b
$ ([Behavior t q] -> [Behavior t q])
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (([Behavior t q] -> [Behavior t q])
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      ())
-> ([Behavior t q] -> [Behavior t q])
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
forall a b. (a -> b) -> a -> b
$ (:) (Behavior t q -> [Behavior t q] -> [Behavior t q])
-> Behavior t q -> [Behavior t q] -> [Behavior t q]
forall a b. (a -> b) -> a -> b
$ PullM t q -> Behavior t q
forall k (t :: k) a. Reflex t => PullM t a -> Behavior t a
pull (PullM t q -> Behavior t q) -> PullM t q -> Behavior t q
forall a b. (a -> b) -> a -> b
$ [Behavior t q] -> PullM t q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs ([Behavior t q] -> PullM t q)
-> PullM t [Behavior t q] -> PullM t q
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Behavior t [Behavior t q] -> PullM t [Behavior t q]
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t [Behavior t q]
bbs
    StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  ()
-> QueryT t q m ()
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   ()
 -> QueryT t q m ())
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
-> QueryT t q m ()
forall a b. (a -> b) -> a -> b
$ EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) ()
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) ()
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      ())
-> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) ()
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
forall a b. (a -> b) -> a -> b
$ Event t q
-> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) ()
forall t w (m :: * -> *). EventWriter t w m => Event t w -> m ()
tellEvent Event t q
patches
    (a, Event t b) -> QueryT t q m (a, Event t b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
r0, ((b, [Behavior t q]) -> b)
-> Event t (b, [Behavior t q]) -> Event t b
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap (b, [Behavior t q]) -> b
forall a b. (a, b) -> a
fst Event t (b, [Behavior t q])
r')

  traverseIntMapWithKeyWithAdjust :: forall v v'. (IntMap.Key -> v -> QueryT t q m v') -> IntMap v -> Event t (PatchIntMap v) -> QueryT t q m (IntMap v', Event t (PatchIntMap v'))
  traverseIntMapWithKeyWithAdjust :: (Key -> v -> QueryT t q m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> QueryT t q m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust f :: Key -> v -> QueryT t q m v'
f im0 :: IntMap v
im0 im' :: Event t (PatchIntMap v)
im' = do
    let f' :: IntMap.Key -> v -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) (QueryTLoweredResult t q v')
        f' :: Key
-> v
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (QueryTLoweredResult t q v')
f' k :: Key
k v :: v
v = ((v', [Behavior t q]) -> QueryTLoweredResult t q v')
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q])
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (QueryTLoweredResult t q v')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (v', [Behavior t q]) -> QueryTLoweredResult t q v'
forall t q v. (v, [Behavior t q]) -> QueryTLoweredResult t q v
QueryTLoweredResult (EventWriterT
   t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q])
 -> EventWriterT
      t
      q
      (ReaderT (Dynamic t (QueryResult q)) m)
      (QueryTLoweredResult t q v'))
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q])
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (QueryTLoweredResult t q v')
forall a b. (a -> b) -> a -> b
$ (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   v'
 -> [Behavior t q]
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q]))
-> [Behavior t q]
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     v'
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  v'
-> [Behavior t q]
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT [] (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   v'
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q]))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     v'
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v', [Behavior t q])
forall a b. (a -> b) -> a -> b
$ QueryT t q m v'
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     v'
forall t q (m :: * -> *) a.
QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unQueryT (QueryT t q m v'
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      v')
-> QueryT t q m v'
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     v'
forall a b. (a -> b) -> a -> b
$ Key -> v -> QueryT t q m v'
f Key
k v
v
    (result0 :: IntMap (QueryTLoweredResult t q v')
result0, result' :: Event t (PatchIntMap (QueryTLoweredResult t q v'))
result') <- StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (IntMap (QueryTLoweredResult t q v'),
   Event t (PatchIntMap (QueryTLoweredResult t q v')))
-> QueryT
     t
     q
     m
     (IntMap (QueryTLoweredResult t q v'),
      Event t (PatchIntMap (QueryTLoweredResult t q v')))
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (IntMap (QueryTLoweredResult t q v'),
    Event t (PatchIntMap (QueryTLoweredResult t q v')))
 -> QueryT
      t
      q
      m
      (IntMap (QueryTLoweredResult t q v'),
       Event t (PatchIntMap (QueryTLoweredResult t q v'))))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (IntMap (QueryTLoweredResult t q v'),
      Event t (PatchIntMap (QueryTLoweredResult t q v')))
-> QueryT
     t
     q
     m
     (IntMap (QueryTLoweredResult t q v'),
      Event t (PatchIntMap (QueryTLoweredResult t q v')))
forall a b. (a -> b) -> a -> b
$ EventWriterT
  t
  q
  (ReaderT (Dynamic t (QueryResult q)) m)
  (IntMap (QueryTLoweredResult t q v'),
   Event t (PatchIntMap (QueryTLoweredResult t q v')))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (IntMap (QueryTLoweredResult t q v'),
      Event t (PatchIntMap (QueryTLoweredResult t q v')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT
   t
   q
   (ReaderT (Dynamic t (QueryResult q)) m)
   (IntMap (QueryTLoweredResult t q v'),
    Event t (PatchIntMap (QueryTLoweredResult t q v')))
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      (IntMap (QueryTLoweredResult t q v'),
       Event t (PatchIntMap (QueryTLoweredResult t q v'))))
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (IntMap (QueryTLoweredResult t q v'),
      Event t (PatchIntMap (QueryTLoweredResult t q v')))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (IntMap (QueryTLoweredResult t q v'),
      Event t (PatchIntMap (QueryTLoweredResult t q v')))
forall a b. (a -> b) -> a -> b
$ (Key
 -> v
 -> EventWriterT
      t
      q
      (ReaderT (Dynamic t (QueryResult q)) m)
      (QueryTLoweredResult t q v'))
-> IntMap v
-> Event t (PatchIntMap v)
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (IntMap (QueryTLoweredResult t q v'),
      Event t (PatchIntMap (QueryTLoweredResult t q v')))
forall t (m :: * -> *) v v'.
Adjustable t m =>
(Key -> v -> m v')
-> IntMap v
-> Event t (PatchIntMap v)
-> m (IntMap v', Event t (PatchIntMap v'))
traverseIntMapWithKeyWithAdjust Key
-> v
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (QueryTLoweredResult t q v')
f' IntMap v
im0 Event t (PatchIntMap v)
im'
    let liftedResult0 :: IntMap v'
liftedResult0 = (QueryTLoweredResult t q v' -> v')
-> IntMap (QueryTLoweredResult t q v') -> IntMap v'
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map QueryTLoweredResult t q v' -> v'
forall t q v. QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue IntMap (QueryTLoweredResult t q v')
result0
        liftedResult' :: Event t (PatchIntMap v')
liftedResult' = Event t (PatchIntMap (QueryTLoweredResult t q v'))
-> (PatchIntMap (QueryTLoweredResult t q v') -> PatchIntMap v')
-> Event t (PatchIntMap v')
forall k (t :: k) a b.
Reflex t =>
Event t a -> (a -> b) -> Event t b
fforCheap Event t (PatchIntMap (QueryTLoweredResult t q v'))
result' ((PatchIntMap (QueryTLoweredResult t q v') -> PatchIntMap v')
 -> Event t (PatchIntMap v'))
-> (PatchIntMap (QueryTLoweredResult t q v') -> PatchIntMap v')
-> Event t (PatchIntMap v')
forall a b. (a -> b) -> a -> b
$ \(PatchIntMap p :: IntMap (Maybe (QueryTLoweredResult t q v'))
p) -> IntMap (Maybe v') -> PatchIntMap v'
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe v') -> PatchIntMap v')
-> IntMap (Maybe v') -> PatchIntMap v'
forall a b. (a -> b) -> a -> b
$
          (Maybe (QueryTLoweredResult t q v') -> Maybe v')
-> IntMap (Maybe (QueryTLoweredResult t q v')) -> IntMap (Maybe v')
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map ((QueryTLoweredResult t q v' -> v')
-> Maybe (QueryTLoweredResult t q v') -> Maybe v'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QueryTLoweredResult t q v' -> v'
forall t q v. QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue) IntMap (Maybe (QueryTLoweredResult t q v'))
p
        liftedBs0 :: IntMap [Behavior t q]
        liftedBs0 :: IntMap [Behavior t q]
liftedBs0 = (QueryTLoweredResult t q v' -> [Behavior t q])
-> IntMap (QueryTLoweredResult t q v') -> IntMap [Behavior t q]
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map QueryTLoweredResult t q v' -> [Behavior t q]
forall t q v. QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten IntMap (QueryTLoweredResult t q v')
result0
        liftedBs' :: Event t (PatchIntMap [Behavior t q])
        liftedBs' :: Event t (PatchIntMap [Behavior t q])
liftedBs' = Event t (PatchIntMap (QueryTLoweredResult t q v'))
-> (PatchIntMap (QueryTLoweredResult t q v')
    -> PatchIntMap [Behavior t q])
-> Event t (PatchIntMap [Behavior t q])
forall k (t :: k) a b.
Reflex t =>
Event t a -> (a -> b) -> Event t b
fforCheap Event t (PatchIntMap (QueryTLoweredResult t q v'))
result' ((PatchIntMap (QueryTLoweredResult t q v')
  -> PatchIntMap [Behavior t q])
 -> Event t (PatchIntMap [Behavior t q]))
-> (PatchIntMap (QueryTLoweredResult t q v')
    -> PatchIntMap [Behavior t q])
-> Event t (PatchIntMap [Behavior t q])
forall a b. (a -> b) -> a -> b
$ \(PatchIntMap p :: IntMap (Maybe (QueryTLoweredResult t q v'))
p) -> IntMap (Maybe [Behavior t q]) -> PatchIntMap [Behavior t q]
forall a. IntMap (Maybe a) -> PatchIntMap a
PatchIntMap (IntMap (Maybe [Behavior t q]) -> PatchIntMap [Behavior t q])
-> IntMap (Maybe [Behavior t q]) -> PatchIntMap [Behavior t q]
forall a b. (a -> b) -> a -> b
$
          (Maybe (QueryTLoweredResult t q v') -> Maybe [Behavior t q])
-> IntMap (Maybe (QueryTLoweredResult t q v'))
-> IntMap (Maybe [Behavior t q])
forall a b. (a -> b) -> IntMap a -> IntMap b
IntMap.map ((QueryTLoweredResult t q v' -> [Behavior t q])
-> Maybe (QueryTLoweredResult t q v') -> Maybe [Behavior t q]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap QueryTLoweredResult t q v' -> [Behavior t q]
forall t q v. QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten) IntMap (Maybe (QueryTLoweredResult t q v'))
p
        sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
        sampleBs :: [Behavior t q] -> m' q
sampleBs = (q -> Behavior t q -> m' q) -> q -> [Behavior t q] -> m' q
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\b :: q
b a :: Behavior t q
a -> (q
b q -> q -> q
forall a. Semigroup a => a -> a -> a
<>) (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t q -> m' q
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t q
a) q
forall a. Monoid a => a
mempty
        accumBehaviors :: forall m'. MonadHold t m'
                       => IntMap [Behavior t q]
                       -> PatchIntMap [Behavior t q]
                       -> m' ( Maybe (IntMap [Behavior t q])
                             , Maybe (AdditivePatch q))
        -- f accumulates the child behavior state we receive from running traverseIntMapWithKeyWithAdjust for the underlying monad.
        -- When an update occurs, it also computes a patch to communicate to the parent QueryT state.
        -- bs0 is a Map denoting the behaviors of the current children.
        -- pbs is a PatchMap denoting an update to the behaviors of the current children
        accumBehaviors :: IntMap [Behavior t q]
-> PatchIntMap [Behavior t q]
-> m' (Maybe (IntMap [Behavior t q]), Maybe (AdditivePatch q))
accumBehaviors bs0 :: IntMap [Behavior t q]
bs0 pbs :: PatchIntMap [Behavior t q]
pbs@(PatchIntMap bs' :: IntMap (Maybe [Behavior t q])
bs') = do
          let p :: Key -> Maybe [Behavior t q] -> m' q
p k :: Key
k bs :: Maybe [Behavior t q]
bs = case Key -> IntMap [Behavior t q] -> Maybe [Behavior t q]
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
k IntMap [Behavior t q]
bs0 of
                Nothing -> case Maybe [Behavior t q]
bs of
                  -- If the update is to delete the state for a child that doesn't exist, the patch is mempty.
                  Nothing -> q -> m' q
forall (m :: * -> *) a. Monad m => a -> m a
return q
forall a. Monoid a => a
mempty
                  -- If the update is to update the state for a child that doesn't exist, the patch is the sample of the new state.
                  Just newBs :: [Behavior t q]
newBs -> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs
                Just oldBs :: [Behavior t q]
oldBs -> case Maybe [Behavior t q]
bs of
                  -- If the update is to delete the state for a child that already exists, the patch is the negation of the child's current state
                  Nothing -> q -> q
forall q. Group q => q -> q
negateG (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs
                  -- If the update is to update the state for a child that already exists, the patch is the negation of sampling the child's current state
                  -- composed with the sampling the child's new state.
                  Just newBs :: [Behavior t q]
newBs -> q -> q -> q
forall q. Group q => q -> q -> q
(~~) (q -> q -> q) -> m' q -> m' (q -> q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs m' (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs
          -- we compute the patch by iterating over the update PatchMap and proceeding by cases. Then we fold over the
          -- child patches and wrap them in AdditivePatch.
          AdditivePatch q
patch <- q -> AdditivePatch q
forall p. p -> AdditivePatch p
AdditivePatch (q -> AdditivePatch q)
-> (IntMap q -> q) -> IntMap q -> AdditivePatch q
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IntMap q -> q
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (IntMap q -> AdditivePatch q)
-> m' (IntMap q) -> m' (AdditivePatch q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Key -> Maybe [Behavior t q] -> m' q)
-> IntMap (Maybe [Behavior t q]) -> m' (IntMap q)
forall (t :: * -> *) a b.
Applicative t =>
(Key -> a -> t b) -> IntMap a -> t (IntMap b)
IntMap.traverseWithKey Key -> Maybe [Behavior t q] -> m' q
p IntMap (Maybe [Behavior t q])
bs'
          (Maybe (IntMap [Behavior t q]), Maybe (AdditivePatch q))
-> m' (Maybe (IntMap [Behavior t q]), Maybe (AdditivePatch q))
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchIntMap [Behavior t q]
-> PatchTarget (PatchIntMap [Behavior t q])
-> Maybe (PatchTarget (PatchIntMap [Behavior t q]))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchIntMap [Behavior t q]
pbs IntMap [Behavior t q]
PatchTarget (PatchIntMap [Behavior t q])
bs0, AdditivePatch q -> Maybe (AdditivePatch q)
forall a. a -> Maybe a
Just AdditivePatch q
patch)
    (Event t (AdditivePatch q)
qpatch :: Event t (AdditivePatch q)) <- (IntMap [Behavior t q]
 -> PatchIntMap [Behavior t q]
 -> PushM
      t (Maybe (IntMap [Behavior t q]), Maybe (AdditivePatch q)))
-> IntMap [Behavior t q]
-> Event t (PatchIntMap [Behavior t q])
-> QueryT t q m (Event t (AdditivePatch q))
forall k (t :: k) (m :: * -> *) a b c.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> PushM t (Maybe a, Maybe c))
-> a -> Event t b -> m (Event t c)
mapAccumMaybeM_ IntMap [Behavior t q]
-> PatchIntMap [Behavior t q]
-> PushM t (Maybe (IntMap [Behavior t q]), Maybe (AdditivePatch q))
forall (m' :: * -> *).
MonadHold t m' =>
IntMap [Behavior t q]
-> PatchIntMap [Behavior t q]
-> m' (Maybe (IntMap [Behavior t q]), Maybe (AdditivePatch q))
accumBehaviors IntMap [Behavior t q]
liftedBs0 Event t (PatchIntMap [Behavior t q])
liftedBs'
    Incremental t (AdditivePatch q) -> QueryT t q m ()
forall t q (m :: * -> *).
MonadQuery t q m =>
Incremental t (AdditivePatch q) -> m ()
tellQueryIncremental (Incremental t (AdditivePatch q) -> QueryT t q m ())
-> Incremental t (AdditivePatch q) -> QueryT t q m ()
forall a b. (a -> b) -> a -> b
$ PullM t (PatchTarget (AdditivePatch q))
-> Event t (AdditivePatch q) -> Incremental t (AdditivePatch q)
forall k (t :: k) p.
(Reflex t, Patch p) =>
PullM t (PatchTarget p) -> Event t p -> Incremental t p
unsafeBuildIncremental (IntMap q -> q
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (IntMap q -> q) -> PullM t (IntMap q) -> PullM t q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Behavior t q] -> PullM t q)
-> IntMap [Behavior t q] -> PullM t (IntMap q)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Behavior t q] -> PullM t q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs IntMap [Behavior t q]
liftedBs0) Event t (AdditivePatch q)
qpatch
    (IntMap v', Event t (PatchIntMap v'))
-> QueryT t q m (IntMap v', Event t (PatchIntMap v'))
forall (m :: * -> *) a. Monad m => a -> m a
return (IntMap v'
liftedResult0, Event t (PatchIntMap v')
liftedResult')

  traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) v v'. (DMap.GCompare k) => (forall a. k a -> v a -> QueryT t q m (v' a)) -> DMap k v -> Event t (PatchDMap k v) -> QueryT t q m (DMap k v', Event t (PatchDMap k v'))
  traverseDMapWithKeyWithAdjust :: (forall a. k a -> v a -> QueryT t q m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> QueryT t q m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust f :: forall a. k a -> v a -> QueryT t q m (v' a)
f dm0 :: DMap k v
dm0 dm' :: Event t (PatchDMap k v)
dm' = do
    let f' :: forall a. k a -> v a -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) (Compose (QueryTLoweredResult t q) v' a)
        f' :: k a
-> v a
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
f' k :: k a
k v :: v a
v = ((v' a, [Behavior t q]) -> Compose (QueryTLoweredResult t q) v' a)
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QueryTLoweredResult t q (v' a)
-> Compose (QueryTLoweredResult t q) v' a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (QueryTLoweredResult t q (v' a)
 -> Compose (QueryTLoweredResult t q) v' a)
-> ((v' a, [Behavior t q]) -> QueryTLoweredResult t q (v' a))
-> (v' a, [Behavior t q])
-> Compose (QueryTLoweredResult t q) v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v' a, [Behavior t q]) -> QueryTLoweredResult t q (v' a)
forall t q v. (v, [Behavior t q]) -> QueryTLoweredResult t q v
QueryTLoweredResult) (EventWriterT
   t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
 -> EventWriterT
      t
      q
      (ReaderT (Dynamic t (QueryResult q)) m)
      (Compose (QueryTLoweredResult t q) v' a))
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
forall a b. (a -> b) -> a -> b
$ (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (v' a)
 -> [Behavior t q]
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q]))
-> [Behavior t q]
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (v' a)
-> [Behavior t q]
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT [] (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (v' a)
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q]))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
forall a b. (a -> b) -> a -> b
$ QueryT t q m (v' a)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
forall t q (m :: * -> *) a.
QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unQueryT (QueryT t q m (v' a)
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      (v' a))
-> QueryT t q m (v' a)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> QueryT t q m (v' a)
forall a. k a -> v a -> QueryT t q m (v' a)
f k a
k v a
v
    (result0 :: DMap k (Compose (QueryTLoweredResult t q) v')
result0, result' :: Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v'))
result') <- StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (DMap k (Compose (QueryTLoweredResult t q) v'),
   Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
-> QueryT
     t
     q
     m
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (DMap k (Compose (QueryTLoweredResult t q) v'),
    Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
 -> QueryT
      t
      q
      m
      (DMap k (Compose (QueryTLoweredResult t q) v'),
       Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v'))))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
-> QueryT
     t
     q
     m
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
forall a b. (a -> b) -> a -> b
$ EventWriterT
  t
  q
  (ReaderT (Dynamic t (QueryResult q)) m)
  (DMap k (Compose (QueryTLoweredResult t q) v'),
   Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT
   t
   q
   (ReaderT (Dynamic t (QueryResult q)) m)
   (DMap k (Compose (QueryTLoweredResult t q) v'),
    Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      (DMap k (Compose (QueryTLoweredResult t q) v'),
       Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v'))))
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
forall a b. (a -> b) -> a -> b
$ (forall a.
 k a
 -> v a
 -> EventWriterT
      t
      q
      (ReaderT (Dynamic t (QueryResult q)) m)
      (Compose (QueryTLoweredResult t q) v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v')))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMap k v)
-> m (DMap k v', Event t (PatchDMap k v'))
traverseDMapWithKeyWithAdjust forall a.
k a
-> v a
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
f' DMap k v
dm0 Event t (PatchDMap k v)
dm'
    let liftedResult0 :: DMap k v'
liftedResult0 = (DSum k (Compose (QueryTLoweredResult t q) v') -> DSum k v')
-> DMap k (Compose (QueryTLoweredResult t q) v') -> DMap k v'
forall k1 k2 (k3 :: k1 -> *) (v :: k1 -> *) (k' :: k2 -> *)
       (v' :: k2 -> *).
(DSum k3 v -> DSum k' v') -> DMap k3 v -> DMap k' v'
mapKeyValuePairsMonotonic (\(k :: k a
k :=> Compose r) -> k a
k k a -> v' a -> DSum k v'
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> QueryTLoweredResult t q (v' a) -> v' a
forall t q v. QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue QueryTLoweredResult t q (v' a)
r) DMap k (Compose (QueryTLoweredResult t q) v')
result0
        liftedResult' :: Event t (PatchDMap k v')
liftedResult' = Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v'))
-> (PatchDMap k (Compose (QueryTLoweredResult t q) v')
    -> PatchDMap k v')
-> Event t (PatchDMap k v')
forall k (t :: k) a b.
Reflex t =>
Event t a -> (a -> b) -> Event t b
fforCheap Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v'))
result' ((PatchDMap k (Compose (QueryTLoweredResult t q) v')
  -> PatchDMap k v')
 -> Event t (PatchDMap k v'))
-> (PatchDMap k (Compose (QueryTLoweredResult t q) v')
    -> PatchDMap k v')
-> Event t (PatchDMap k v')
forall a b. (a -> b) -> a -> b
$ \(PatchDMap p :: DMap k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
p) -> DMap k (ComposeMaybe v') -> PatchDMap k v'
forall k (k1 :: k -> *) (v :: k -> *).
DMap k1 (ComposeMaybe v) -> PatchDMap k1 v
PatchDMap (DMap k (ComposeMaybe v') -> PatchDMap k v')
-> DMap k (ComposeMaybe v') -> PatchDMap k v'
forall a b. (a -> b) -> a -> b
$
          (DSum k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
 -> DSum k (ComposeMaybe v'))
-> DMap k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
-> DMap k (ComposeMaybe v')
forall k1 k2 (k3 :: k1 -> *) (v :: k1 -> *) (k' :: k2 -> *)
       (v' :: k2 -> *).
(DSum k3 v -> DSum k' v') -> DMap k3 v -> DMap k' v'
mapKeyValuePairsMonotonic (\(k :: k a
k :=> ComposeMaybe mr) -> k a
k k a -> ComposeMaybe v' a -> DSum k (ComposeMaybe v')
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> Maybe (v' a) -> ComposeMaybe v' a
forall k (f :: k -> *) (a :: k). Maybe (f a) -> ComposeMaybe f a
ComposeMaybe ((Compose (QueryTLoweredResult t q) v' a -> v' a)
-> Maybe (Compose (QueryTLoweredResult t q) v' a) -> Maybe (v' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QueryTLoweredResult t q (v' a) -> v' a
forall t q v. QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue (QueryTLoweredResult t q (v' a) -> v' a)
-> (Compose (QueryTLoweredResult t q) v' a
    -> QueryTLoweredResult t q (v' a))
-> Compose (QueryTLoweredResult t q) v' a
-> v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (QueryTLoweredResult t q) v' a
-> QueryTLoweredResult t q (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) Maybe (Compose (QueryTLoweredResult t q) v' a)
mr)) DMap k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
p
        liftedBs0 :: Map (Some k) [Behavior t q]
        liftedBs0 :: Map (Some k) [Behavior t q]
liftedBs0 = [(Some k, [Behavior t q])] -> Map (Some k) [Behavior t q]
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Some k, [Behavior t q])] -> Map (Some k) [Behavior t q])
-> [(Some k, [Behavior t q])] -> Map (Some k) [Behavior t q]
forall a b. (a -> b) -> a -> b
$ (\(k :: k a
k :=> Compose r) -> (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k, QueryTLoweredResult t q (v' a) -> [Behavior t q]
forall t q v. QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten QueryTLoweredResult t q (v' a)
r)) (DSum k (Compose (QueryTLoweredResult t q) v')
 -> (Some k, [Behavior t q]))
-> [DSum k (Compose (QueryTLoweredResult t q) v')]
-> [(Some k, [Behavior t q])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DMap k (Compose (QueryTLoweredResult t q) v')
-> [DSum k (Compose (QueryTLoweredResult t q) v')]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (Compose (QueryTLoweredResult t q) v')
result0
        liftedBs' :: Event t (PatchMap (Some k) [Behavior t q])
        liftedBs' :: Event t (PatchMap (Some k) [Behavior t q])
liftedBs' = Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v'))
-> (PatchDMap k (Compose (QueryTLoweredResult t q) v')
    -> PatchMap (Some k) [Behavior t q])
-> Event t (PatchMap (Some k) [Behavior t q])
forall k (t :: k) a b.
Reflex t =>
Event t a -> (a -> b) -> Event t b
fforCheap Event t (PatchDMap k (Compose (QueryTLoweredResult t q) v'))
result' ((PatchDMap k (Compose (QueryTLoweredResult t q) v')
  -> PatchMap (Some k) [Behavior t q])
 -> Event t (PatchMap (Some k) [Behavior t q]))
-> (PatchDMap k (Compose (QueryTLoweredResult t q) v')
    -> PatchMap (Some k) [Behavior t q])
-> Event t (PatchMap (Some k) [Behavior t q])
forall a b. (a -> b) -> a -> b
$ \(PatchDMap p :: DMap k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
p) -> Map (Some k) (Maybe [Behavior t q])
-> PatchMap (Some k) [Behavior t q]
forall k v. Map k (Maybe v) -> PatchMap k v
PatchMap (Map (Some k) (Maybe [Behavior t q])
 -> PatchMap (Some k) [Behavior t q])
-> Map (Some k) (Maybe [Behavior t q])
-> PatchMap (Some k) [Behavior t q]
forall a b. (a -> b) -> a -> b
$
          [(Some k, Maybe [Behavior t q])]
-> Map (Some k) (Maybe [Behavior t q])
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Some k, Maybe [Behavior t q])]
 -> Map (Some k) (Maybe [Behavior t q]))
-> [(Some k, Maybe [Behavior t q])]
-> Map (Some k) (Maybe [Behavior t q])
forall a b. (a -> b) -> a -> b
$ (\(k :: k a
k :=> ComposeMaybe mr) -> (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k, (Compose (QueryTLoweredResult t q) v' a -> [Behavior t q])
-> Maybe (Compose (QueryTLoweredResult t q) v' a)
-> Maybe [Behavior t q]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QueryTLoweredResult t q (v' a) -> [Behavior t q]
forall t q v. QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten (QueryTLoweredResult t q (v' a) -> [Behavior t q])
-> (Compose (QueryTLoweredResult t q) v' a
    -> QueryTLoweredResult t q (v' a))
-> Compose (QueryTLoweredResult t q) v' a
-> [Behavior t q]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (QueryTLoweredResult t q) v' a
-> QueryTLoweredResult t q (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) Maybe (Compose (QueryTLoweredResult t q) v' a)
mr)) (DSum k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
 -> (Some k, Maybe [Behavior t q]))
-> [DSum k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))]
-> [(Some k, Maybe [Behavior t q])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DMap k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
-> [DSum k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (ComposeMaybe (Compose (QueryTLoweredResult t q) v'))
p
        sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
        sampleBs :: [Behavior t q] -> m' q
sampleBs = (q -> Behavior t q -> m' q) -> q -> [Behavior t q] -> m' q
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\b :: q
b a :: Behavior t q
a -> (q
b q -> q -> q
forall a. Semigroup a => a -> a -> a
<>) (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t q -> m' q
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t q
a) q
forall a. Monoid a => a
mempty
        accumBehaviors :: forall m'. MonadHold t m'
                       => Map (Some k) [Behavior t q]
                       -> PatchMap (Some k) [Behavior t q]
                       -> m' ( Maybe (Map (Some k) [Behavior t q])
                             , Maybe (AdditivePatch q))
        -- f accumulates the child behavior state we receive from running traverseDMapWithKeyWithAdjust for the underlying monad.
        -- When an update occurs, it also computes a patch to communicate to the parent QueryT state.
        -- bs0 is a Map denoting the behaviors of the current children.
        -- pbs is a PatchMap denoting an update to the behaviors of the current children
        accumBehaviors :: Map (Some k) [Behavior t q]
-> PatchMap (Some k) [Behavior t q]
-> m'
     (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
accumBehaviors bs0 :: Map (Some k) [Behavior t q]
bs0 pbs :: PatchMap (Some k) [Behavior t q]
pbs@(PatchMap bs' :: Map (Some k) (Maybe [Behavior t q])
bs') = do
          let p :: Some k -> Maybe [Behavior t q] -> m' (Maybe q)
p k :: Some k
k bs :: Maybe [Behavior t q]
bs = case Some k -> Map (Some k) [Behavior t q] -> Maybe [Behavior t q]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Some k
k Map (Some k) [Behavior t q]
bs0 of
                Nothing -> case Maybe [Behavior t q]
bs of
                  -- If the update is to delete the state for a child that doesn't exist, the patch is mempty.
                  Nothing -> Maybe q -> m' (Maybe q)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe q
forall a. Maybe a
Nothing
                  -- If the update is to update the state for a child that doesn't exist, the patch is the sample of the new state.
                  Just newBs :: [Behavior t q]
newBs -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs
                Just oldBs :: [Behavior t q]
oldBs -> case Maybe [Behavior t q]
bs of
                  -- If the update is to delete the state for a child that already exists, the patch is the negation of the child's current state
                  Nothing -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> (q -> q) -> q -> Maybe q
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q -> q
forall q. Group q => q -> q
negateG (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs
                  -- If the update is to update the state for a child that already exists, the patch is the negation of sampling the child's current state
                  -- composed with the sampling the child's new state.
                  Just newBs :: [Behavior t q]
newBs -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (q -> q -> q
forall q. Group q => q -> q -> q
(~~) (q -> q -> q) -> m' q -> m' (q -> q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs m' (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs)
          -- we compute the patch by iterating over the update PatchMap and proceeding by cases. Then we fold over the
          -- child patches and wrap them in AdditivePatch.
          Maybe q
patch <- Map (Some k) (Maybe q) -> Maybe q
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Some k) (Maybe q) -> Maybe q)
-> m' (Map (Some k) (Maybe q)) -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Some k -> Maybe [Behavior t q] -> m' (Maybe q))
-> Map (Some k) (Maybe [Behavior t q])
-> m' (Map (Some k) (Maybe q))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Some k -> Maybe [Behavior t q] -> m' (Maybe q)
p Map (Some k) (Maybe [Behavior t q])
bs'
          (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
-> m'
     (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchMap (Some k) [Behavior t q]
-> PatchTarget (PatchMap (Some k) [Behavior t q])
-> Maybe (PatchTarget (PatchMap (Some k) [Behavior t q]))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchMap (Some k) [Behavior t q]
pbs Map (Some k) [Behavior t q]
PatchTarget (PatchMap (Some k) [Behavior t q])
bs0, q -> AdditivePatch q
forall p. p -> AdditivePatch p
AdditivePatch (q -> AdditivePatch q) -> Maybe q -> Maybe (AdditivePatch q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe q
patch)
    (Event t (AdditivePatch q)
qpatch :: Event t (AdditivePatch q)) <- (Map (Some k) [Behavior t q]
 -> PatchMap (Some k) [Behavior t q]
 -> PushM
      t (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q)))
-> Map (Some k) [Behavior t q]
-> Event t (PatchMap (Some k) [Behavior t q])
-> QueryT t q m (Event t (AdditivePatch q))
forall k (t :: k) (m :: * -> *) a b c.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> PushM t (Maybe a, Maybe c))
-> a -> Event t b -> m (Event t c)
mapAccumMaybeM_ Map (Some k) [Behavior t q]
-> PatchMap (Some k) [Behavior t q]
-> PushM
     t (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
forall (m' :: * -> *).
MonadHold t m' =>
Map (Some k) [Behavior t q]
-> PatchMap (Some k) [Behavior t q]
-> m'
     (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
accumBehaviors Map (Some k) [Behavior t q]
liftedBs0 Event t (PatchMap (Some k) [Behavior t q])
liftedBs'
    Incremental t (AdditivePatch q) -> QueryT t q m ()
forall t q (m :: * -> *).
MonadQuery t q m =>
Incremental t (AdditivePatch q) -> m ()
tellQueryIncremental (Incremental t (AdditivePatch q) -> QueryT t q m ())
-> Incremental t (AdditivePatch q) -> QueryT t q m ()
forall a b. (a -> b) -> a -> b
$ PullM t (PatchTarget (AdditivePatch q))
-> Event t (AdditivePatch q) -> Incremental t (AdditivePatch q)
forall k (t :: k) p.
(Reflex t, Patch p) =>
PullM t (PatchTarget p) -> Event t p -> Incremental t p
unsafeBuildIncremental (Map (Some k) q -> q
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Some k) q -> q) -> PullM t (Map (Some k) q) -> PullM t q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Behavior t q] -> PullM t q)
-> Map (Some k) [Behavior t q] -> PullM t (Map (Some k) q)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Behavior t q] -> PullM t q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs Map (Some k) [Behavior t q]
liftedBs0) Event t (AdditivePatch q)
qpatch
    (DMap k v', Event t (PatchDMap k v'))
-> QueryT t q m (DMap k v', Event t (PatchDMap k v'))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k v'
liftedResult0, Event t (PatchDMap k v')
liftedResult')

  traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) v v'. (DMap.GCompare k) => (forall a. k a -> v a -> QueryT t q m (v' a)) -> DMap k v -> Event t (PatchDMapWithMove k v) -> QueryT t q m (DMap k v', Event t (PatchDMapWithMove k v'))
  traverseDMapWithKeyWithAdjustWithMove :: (forall a. k a -> v a -> QueryT t q m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> QueryT t q m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove f :: forall a. k a -> v a -> QueryT t q m (v' a)
f dm0 :: DMap k v
dm0 dm' :: Event t (PatchDMapWithMove k v)
dm' = do
    let f' :: forall a. k a -> v a -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) (Compose (QueryTLoweredResult t q) v' a)
        f' :: k a
-> v a
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
f' k :: k a
k v :: v a
v = ((v' a, [Behavior t q]) -> Compose (QueryTLoweredResult t q) v' a)
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QueryTLoweredResult t q (v' a)
-> Compose (QueryTLoweredResult t q) v' a
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (QueryTLoweredResult t q (v' a)
 -> Compose (QueryTLoweredResult t q) v' a)
-> ((v' a, [Behavior t q]) -> QueryTLoweredResult t q (v' a))
-> (v' a, [Behavior t q])
-> Compose (QueryTLoweredResult t q) v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v' a, [Behavior t q]) -> QueryTLoweredResult t q (v' a)
forall t q v. (v, [Behavior t q]) -> QueryTLoweredResult t q v
QueryTLoweredResult) (EventWriterT
   t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
 -> EventWriterT
      t
      q
      (ReaderT (Dynamic t (QueryResult q)) m)
      (Compose (QueryTLoweredResult t q) v' a))
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
forall a b. (a -> b) -> a -> b
$ (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (v' a)
 -> [Behavior t q]
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q]))
-> [Behavior t q]
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (v' a)
-> [Behavior t q]
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT [] (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (v' a)
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q]))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (v' a, [Behavior t q])
forall a b. (a -> b) -> a -> b
$ QueryT t q m (v' a)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
forall t q (m :: * -> *) a.
QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unQueryT (QueryT t q m (v' a)
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      (v' a))
-> QueryT t q m (v' a)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (v' a)
forall a b. (a -> b) -> a -> b
$ k a -> v a -> QueryT t q m (v' a)
forall a. k a -> v a -> QueryT t q m (v' a)
f k a
k v a
v
    (result0 :: DMap k (Compose (QueryTLoweredResult t q) v')
result0, result' :: Event
  t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v'))
result') <- StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (DMap k (Compose (QueryTLoweredResult t q) v'),
   Event
     t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
-> QueryT
     t
     q
     m
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event
        t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (DMap k (Compose (QueryTLoweredResult t q) v'),
    Event
      t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
 -> QueryT
      t
      q
      m
      (DMap k (Compose (QueryTLoweredResult t q) v'),
       Event
         t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v'))))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event
        t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
-> QueryT
     t
     q
     m
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event
        t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
forall a b. (a -> b) -> a -> b
$ EventWriterT
  t
  q
  (ReaderT (Dynamic t (QueryResult q)) m)
  (DMap k (Compose (QueryTLoweredResult t q) v'),
   Event
     t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event
        t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT
   t
   q
   (ReaderT (Dynamic t (QueryResult q)) m)
   (DMap k (Compose (QueryTLoweredResult t q) v'),
    Event
      t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      (DMap k (Compose (QueryTLoweredResult t q) v'),
       Event
         t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v'))))
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event
        t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event
        t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
forall a b. (a -> b) -> a -> b
$ (forall a.
 k a
 -> v a
 -> EventWriterT
      t
      q
      (ReaderT (Dynamic t (QueryResult q)) m)
      (Compose (QueryTLoweredResult t q) v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (DMap k (Compose (QueryTLoweredResult t q) v'),
      Event
        t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')))
forall t (m :: * -> *) (k :: * -> *) (v :: * -> *) (v' :: * -> *).
(Adjustable t m, GCompare k) =>
(forall a. k a -> v a -> m (v' a))
-> DMap k v
-> Event t (PatchDMapWithMove k v)
-> m (DMap k v', Event t (PatchDMapWithMove k v'))
traverseDMapWithKeyWithAdjustWithMove forall a.
k a
-> v a
-> EventWriterT
     t
     q
     (ReaderT (Dynamic t (QueryResult q)) m)
     (Compose (QueryTLoweredResult t q) v' a)
f' DMap k v
dm0 Event t (PatchDMapWithMove k v)
dm'
    let liftedResult0 :: DMap k v'
liftedResult0 = (DSum k (Compose (QueryTLoweredResult t q) v') -> DSum k v')
-> DMap k (Compose (QueryTLoweredResult t q) v') -> DMap k v'
forall k1 k2 (k3 :: k1 -> *) (v :: k1 -> *) (k' :: k2 -> *)
       (v' :: k2 -> *).
(DSum k3 v -> DSum k' v') -> DMap k3 v -> DMap k' v'
mapKeyValuePairsMonotonic (\(k :: k a
k :=> Compose r) -> k a
k k a -> v' a -> DSum k v'
forall k (tag :: k -> *) (f :: k -> *) (a :: k).
tag a -> f a -> DSum tag f
:=> QueryTLoweredResult t q (v' a) -> v' a
forall t q v. QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue QueryTLoweredResult t q (v' a)
r) DMap k (Compose (QueryTLoweredResult t q) v')
result0
        liftedResult' :: Event t (PatchDMapWithMove k v')
liftedResult' = Event
  t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v'))
-> (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
    -> PatchDMapWithMove k v')
-> Event t (PatchDMapWithMove k v')
forall k (t :: k) a b.
Reflex t =>
Event t a -> (a -> b) -> Event t b
fforCheap Event
  t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v'))
result' ((PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
  -> PatchDMapWithMove k v')
 -> Event t (PatchDMapWithMove k v'))
-> (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
    -> PatchDMapWithMove k v')
-> Event t (PatchDMapWithMove k v')
forall a b. (a -> b) -> a -> b
$ (forall a. Compose (QueryTLoweredResult t q) v' a -> v' a)
-> PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
-> PatchDMapWithMove k v'
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) (v' :: k1 -> *).
(forall (a :: k1). v a -> v' a)
-> PatchDMapWithMove k2 v -> PatchDMapWithMove k2 v'
mapPatchDMapWithMove (QueryTLoweredResult t q (v' a) -> v' a
forall t q v. QueryTLoweredResult t q v -> v
getQueryTLoweredResultValue (QueryTLoweredResult t q (v' a) -> v' a)
-> (Compose (QueryTLoweredResult t q) v' a
    -> QueryTLoweredResult t q (v' a))
-> Compose (QueryTLoweredResult t q) v' a
-> v' a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (QueryTLoweredResult t q) v' a
-> QueryTLoweredResult t q (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose)
        liftedBs0 :: Map (Some k) [Behavior t q]
        liftedBs0 :: Map (Some k) [Behavior t q]
liftedBs0 = [(Some k, [Behavior t q])] -> Map (Some k) [Behavior t q]
forall k a. [(k, a)] -> Map k a
Map.fromDistinctAscList ([(Some k, [Behavior t q])] -> Map (Some k) [Behavior t q])
-> [(Some k, [Behavior t q])] -> Map (Some k) [Behavior t q]
forall a b. (a -> b) -> a -> b
$ (\(k :: k a
k :=> Compose r) -> (k a -> Some k
forall k (tag :: k -> *) (a :: k). tag a -> Some tag
Some k a
k, QueryTLoweredResult t q (v' a) -> [Behavior t q]
forall t q v. QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten QueryTLoweredResult t q (v' a)
r)) (DSum k (Compose (QueryTLoweredResult t q) v')
 -> (Some k, [Behavior t q]))
-> [DSum k (Compose (QueryTLoweredResult t q) v')]
-> [(Some k, [Behavior t q])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DMap k (Compose (QueryTLoweredResult t q) v')
-> [DSum k (Compose (QueryTLoweredResult t q) v')]
forall k1 (k2 :: k1 -> *) (f :: k1 -> *). DMap k2 f -> [DSum k2 f]
DMap.toList DMap k (Compose (QueryTLoweredResult t q) v')
result0
        liftedBs' :: Event t (PatchMapWithMove (Some k) [Behavior t q])
        liftedBs' :: Event t (PatchMapWithMove (Some k) [Behavior t q])
liftedBs' = Event
  t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v'))
-> (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
    -> PatchMapWithMove (Some k) [Behavior t q])
-> Event t (PatchMapWithMove (Some k) [Behavior t q])
forall k (t :: k) a b.
Reflex t =>
Event t a -> (a -> b) -> Event t b
fforCheap Event
  t (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v'))
result' ((PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
  -> PatchMapWithMove (Some k) [Behavior t q])
 -> Event t (PatchMapWithMove (Some k) [Behavior t q]))
-> (PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
    -> PatchMapWithMove (Some k) [Behavior t q])
-> Event t (PatchMapWithMove (Some k) [Behavior t q])
forall a b. (a -> b) -> a -> b
$ (forall a.
 Compose (QueryTLoweredResult t q) v' a -> [Behavior t q])
-> PatchDMapWithMove k (Compose (QueryTLoweredResult t q) v')
-> PatchMapWithMove (Some k) [Behavior t q]
forall k1 (k2 :: k1 -> *) (v :: k1 -> *) v'.
(forall (a :: k1). v a -> v')
-> PatchDMapWithMove k2 v -> PatchMapWithMove (Some k2) v'
weakenPatchDMapWithMoveWith (QueryTLoweredResult t q (v' a) -> [Behavior t q]
forall t q v. QueryTLoweredResult t q v -> [Behavior t q]
getQueryTLoweredResultWritten (QueryTLoweredResult t q (v' a) -> [Behavior t q])
-> (Compose (QueryTLoweredResult t q) v' a
    -> QueryTLoweredResult t q (v' a))
-> Compose (QueryTLoweredResult t q) v' a
-> [Behavior t q]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compose (QueryTLoweredResult t q) v' a
-> QueryTLoweredResult t q (v' a)
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose) {- \(PatchDMap p) -> PatchMapWithMove $
          Map.fromDistinctAscList $ (\(k :=> mr) -> (Some k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}
        sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
        sampleBs :: [Behavior t q] -> m' q
sampleBs = (q -> Behavior t q -> m' q) -> q -> [Behavior t q] -> m' q
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (\b :: q
b a :: Behavior t q
a -> (q
b q -> q -> q
forall a. Semigroup a => a -> a -> a
<>) (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t q -> m' q
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample Behavior t q
a) q
forall a. Monoid a => a
mempty
        accumBehaviors' :: forall m'. MonadHold t m'
                        => Map (Some k) [Behavior t q]
                        -> PatchMapWithMove (Some k) [Behavior t q]
                        -> m' ( Maybe (Map (Some k) [Behavior t q])
                              , Maybe (AdditivePatch q))
        -- f accumulates the child behavior state we receive from running traverseDMapWithKeyWithAdjustWithMove for the underlying monad.
        -- When an update occurs, it also computes a patch to communicate to the parent QueryT state.
        -- bs0 is a Map denoting the behaviors of the current children.
        -- pbs is a PatchMapWithMove denoting an update to the behaviors of the current children
        accumBehaviors' :: Map (Some k) [Behavior t q]
-> PatchMapWithMove (Some k) [Behavior t q]
-> m'
     (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
accumBehaviors' bs0 :: Map (Some k) [Behavior t q]
bs0 pbs :: PatchMapWithMove (Some k) [Behavior t q]
pbs = do
          let bs' :: Map (Some k) (NodeInfo (Some k) [Behavior t q])
bs' = PatchMapWithMove (Some k) [Behavior t q]
-> Map (Some k) (NodeInfo (Some k) [Behavior t q])
forall k v. PatchMapWithMove k v -> Map k (NodeInfo k v)
unPatchMapWithMove PatchMapWithMove (Some k) [Behavior t q]
pbs
              p :: Some k -> NodeInfo (Some k) [Behavior t q] -> m' (Maybe q)
p k :: Some k
k bs :: NodeInfo (Some k) [Behavior t q]
bs = case Some k -> Map (Some k) [Behavior t q] -> Maybe [Behavior t q]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Some k
k Map (Some k) [Behavior t q]
bs0 of
                Nothing -> case NodeInfo (Some k) [Behavior t q] -> From (Some k) [Behavior t q]
forall k v. NodeInfo k v -> From k v
MapWithMove._nodeInfo_from NodeInfo (Some k) [Behavior t q]
bs of
                  -- If the update is to delete the state for a child that doesn't exist, the patch is mempty.
                  MapWithMove.From_Delete -> Maybe q -> m' (Maybe q)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe q
forall a. Maybe a
Nothing
                  -- If the update is to update the state for a child that doesn't exist, the patch is the sample of the new state.
                  MapWithMove.From_Insert newBs :: [Behavior t q]
newBs -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs
                  MapWithMove.From_Move k' :: Some k
k' -> case Some k -> Map (Some k) [Behavior t q] -> Maybe [Behavior t q]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Some k
k' Map (Some k) [Behavior t q]
bs0 of
                    Nothing -> Maybe q -> m' (Maybe q)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe q
forall a. Maybe a
Nothing
                    Just newBs :: [Behavior t q]
newBs -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs
                Just oldBs :: [Behavior t q]
oldBs -> case NodeInfo (Some k) [Behavior t q] -> From (Some k) [Behavior t q]
forall k v. NodeInfo k v -> From k v
MapWithMove._nodeInfo_from NodeInfo (Some k) [Behavior t q]
bs of
                  -- If the update is to delete the state for a child that already exists, the patch is the negation of the child's current state
                  MapWithMove.From_Delete -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> (q -> q) -> q -> Maybe q
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q -> q
forall q. Group q => q -> q
negateG (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs
                  -- If the update is to update the state for a child that already exists, the patch is the negation of sampling the child's current state
                  -- composed with the sampling the child's new state.
                  MapWithMove.From_Insert newBs :: [Behavior t q]
newBs -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (q -> q -> q
forall q. Group q => q -> q -> q
(~~) (q -> q -> q) -> m' q -> m' (q -> q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs m' (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs)
                  MapWithMove.From_Move k' :: Some k
k'
                    | Some k
k' Some k -> Some k -> Bool
forall a. Eq a => a -> a -> Bool
== Some k
k -> Maybe q -> m' (Maybe q)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe q
forall a. Maybe a
Nothing
                    | Bool
otherwise -> case Some k -> Map (Some k) [Behavior t q] -> Maybe [Behavior t q]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Some k
k' Map (Some k) [Behavior t q]
bs0 of
                  -- If we are moving from a non-existent key, that is a delete
                        Nothing -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> (q -> q) -> q -> Maybe q
forall b c a. (b -> c) -> (a -> b) -> a -> c
. q -> q
forall q. Group q => q -> q
negateG (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs
                        Just newBs :: [Behavior t q]
newBs -> q -> Maybe q
forall a. (Eq a, Monoid a) => a -> Maybe a
maskMempty (q -> Maybe q) -> m' q -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (q -> q -> q
forall q. Group q => q -> q -> q
(~~) (q -> q -> q) -> m' q -> m' (q -> q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
newBs m' (q -> q) -> m' q -> m' q
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Behavior t q] -> m' q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs [Behavior t q]
oldBs)
          -- we compute the patch by iterating over the update PatchMap and proceeding by cases. Then we fold over the
          -- child patches and wrap them in AdditivePatch.
          Maybe q
patch <- Map (Some k) (Maybe q) -> Maybe q
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Some k) (Maybe q) -> Maybe q)
-> m' (Map (Some k) (Maybe q)) -> m' (Maybe q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Some k -> NodeInfo (Some k) [Behavior t q] -> m' (Maybe q))
-> Map (Some k) (NodeInfo (Some k) [Behavior t q])
-> m' (Map (Some k) (Maybe q))
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey Some k -> NodeInfo (Some k) [Behavior t q] -> m' (Maybe q)
p Map (Some k) (NodeInfo (Some k) [Behavior t q])
bs'
          (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
-> m'
     (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
forall (m :: * -> *) a. Monad m => a -> m a
return (PatchMapWithMove (Some k) [Behavior t q]
-> PatchTarget (PatchMapWithMove (Some k) [Behavior t q])
-> Maybe (PatchTarget (PatchMapWithMove (Some k) [Behavior t q]))
forall p. Patch p => p -> PatchTarget p -> Maybe (PatchTarget p)
apply PatchMapWithMove (Some k) [Behavior t q]
pbs Map (Some k) [Behavior t q]
PatchTarget (PatchMapWithMove (Some k) [Behavior t q])
bs0, q -> AdditivePatch q
forall p. p -> AdditivePatch p
AdditivePatch (q -> AdditivePatch q) -> Maybe q -> Maybe (AdditivePatch q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe q
patch)
    (Event t (AdditivePatch q)
qpatch :: Event t (AdditivePatch q)) <- (Map (Some k) [Behavior t q]
 -> PatchMapWithMove (Some k) [Behavior t q]
 -> PushM
      t (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q)))
-> Map (Some k) [Behavior t q]
-> Event t (PatchMapWithMove (Some k) [Behavior t q])
-> QueryT t q m (Event t (AdditivePatch q))
forall k (t :: k) (m :: * -> *) a b c.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> PushM t (Maybe a, Maybe c))
-> a -> Event t b -> m (Event t c)
mapAccumMaybeM_ Map (Some k) [Behavior t q]
-> PatchMapWithMove (Some k) [Behavior t q]
-> PushM
     t (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
forall (m' :: * -> *).
MonadHold t m' =>
Map (Some k) [Behavior t q]
-> PatchMapWithMove (Some k) [Behavior t q]
-> m'
     (Maybe (Map (Some k) [Behavior t q]), Maybe (AdditivePatch q))
accumBehaviors' Map (Some k) [Behavior t q]
liftedBs0 Event t (PatchMapWithMove (Some k) [Behavior t q])
liftedBs'
    Incremental t (AdditivePatch q) -> QueryT t q m ()
forall t q (m :: * -> *).
MonadQuery t q m =>
Incremental t (AdditivePatch q) -> m ()
tellQueryIncremental (Incremental t (AdditivePatch q) -> QueryT t q m ())
-> Incremental t (AdditivePatch q) -> QueryT t q m ()
forall a b. (a -> b) -> a -> b
$ PullM t (PatchTarget (AdditivePatch q))
-> Event t (AdditivePatch q) -> Incremental t (AdditivePatch q)
forall k (t :: k) p.
(Reflex t, Patch p) =>
PullM t (PatchTarget p) -> Event t p -> Incremental t p
unsafeBuildIncremental (Map (Some k) q -> q
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Map (Some k) q -> q) -> PullM t (Map (Some k) q) -> PullM t q
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Behavior t q] -> PullM t q)
-> Map (Some k) [Behavior t q] -> PullM t (Map (Some k) q)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Behavior t q] -> PullM t q
forall (m' :: * -> *). MonadSample t m' => [Behavior t q] -> m' q
sampleBs Map (Some k) [Behavior t q]
liftedBs0) Event t (AdditivePatch q)
qpatch
    (DMap k v', Event t (PatchDMapWithMove k v'))
-> QueryT t q m (DMap k v', Event t (PatchDMapWithMove k v'))
forall (m :: * -> *) a. Monad m => a -> m a
return (DMap k v'
liftedResult0, Event t (PatchDMapWithMove k v')
liftedResult')

instance MonadTrans (QueryT t q) where
  lift :: m a -> QueryT t q m a
lift = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   a
 -> QueryT t q m a)
-> (m a
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         a)
-> m a
-> QueryT t q m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) a
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      a)
-> (m a
    -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) a)
-> m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Dynamic t (QueryResult q)) m a
-> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT (Dynamic t (QueryResult q)) m a
 -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) a)
-> (m a -> ReaderT (Dynamic t (QueryResult q)) m a)
-> m a
-> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT (Dynamic t (QueryResult q)) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

instance PrimMonad m => PrimMonad (QueryT t q m) where
  type PrimState (QueryT t q m) = PrimState m
  primitive :: (State# (PrimState (QueryT t q m))
 -> (# State# (PrimState (QueryT t q m)), a #))
-> QueryT t q m a
primitive = m a -> QueryT t q m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> QueryT t q m a)
-> ((State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a)
-> (State# (PrimState m) -> (# State# (PrimState m), a #))
-> QueryT t q m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
forall (m :: * -> *) a.
PrimMonad m =>
(State# (PrimState m) -> (# State# (PrimState m), a #)) -> m a
primitive

instance PostBuild t m => PostBuild t (QueryT t q m) where
  getPostBuild :: QueryT t q m (Event t ())
getPostBuild = m (Event t ()) -> QueryT t q m (Event t ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild

instance (MonadAsyncException m) => MonadAsyncException (QueryT t q m) where
  mask :: ((forall a. QueryT t q m a -> QueryT t q m a) -> QueryT t q m b)
-> QueryT t q m b
mask f :: (forall a. QueryT t q m a -> QueryT t q m a) -> QueryT t q m b
f = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  b
-> QueryT t q m b
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   b
 -> QueryT t q m b)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     b
-> QueryT t q m b
forall a b. (a -> b) -> a -> b
$ ((forall a.
  StateT
    [Behavior t q]
    (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
    a
  -> StateT
       [Behavior t q]
       (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
       a)
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      b)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     b
forall (m :: * -> *) b.
MonadAsyncException m =>
((forall a. m a -> m a) -> m b) -> m b
mask (((forall a.
   StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
   -> StateT
        [Behavior t q]
        (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
        a)
  -> StateT
       [Behavior t q]
       (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
       b)
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      b)
-> ((forall a.
     StateT
       [Behavior t q]
       (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
       a
     -> StateT
          [Behavior t q]
          (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
          a)
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         b)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     b
forall a b. (a -> b) -> a -> b
$ \unMask :: forall a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unMask -> QueryT t q m b
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     b
forall t q (m :: * -> *) a.
QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unQueryT (QueryT t q m b
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      b)
-> QueryT t q m b
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     b
forall a b. (a -> b) -> a -> b
$ (forall a. QueryT t q m a -> QueryT t q m a) -> QueryT t q m b
f ((forall a. QueryT t q m a -> QueryT t q m a) -> QueryT t q m b)
-> (forall a. QueryT t q m a -> QueryT t q m a) -> QueryT t q m b
forall a b. (a -> b) -> a -> b
$ StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   a
 -> QueryT t q m a)
-> (QueryT t q m a
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         a)
-> QueryT t q m a
-> QueryT t q m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
forall a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unMask (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   a
 -> StateT
      [Behavior t q]
      (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
      a)
-> (QueryT t q m a
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         a)
-> QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
forall t q (m :: * -> *) a.
QueryT t q m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
unQueryT

instance TriggerEvent t m => TriggerEvent t (QueryT t q m) where
  newTriggerEvent :: QueryT t q m (Event t a, a -> IO ())
newTriggerEvent = m (Event t a, a -> IO ()) -> QueryT t q m (Event t a, a -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t a, a -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO ())
newTriggerEvent
  newTriggerEventWithOnComplete :: QueryT t q m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete = m (Event t a, a -> IO () -> IO ())
-> QueryT t q m (Event t a, a -> IO () -> IO ())
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (Event t a, a -> IO () -> IO ())
forall t (m :: * -> *) a.
TriggerEvent t m =>
m (Event t a, a -> IO () -> IO ())
newTriggerEventWithOnComplete
  newEventWithLazyTriggerWithOnComplete :: ((a -> IO () -> IO ()) -> IO (IO ())) -> QueryT t q m (Event t a)
newEventWithLazyTriggerWithOnComplete = m (Event t a) -> QueryT t q m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> QueryT t q m (Event t a))
-> (((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a))
-> ((a -> IO () -> IO ()) -> IO (IO ()))
-> QueryT t q m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
forall t (m :: * -> *) a.
TriggerEvent t m =>
((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)
newEventWithLazyTriggerWithOnComplete

instance PerformEvent t m => PerformEvent t (QueryT t q m) where
  type Performable (QueryT t q m) = Performable m
  performEvent_ :: Event t (Performable (QueryT t q m) ()) -> QueryT t q m ()
performEvent_ = m () -> QueryT t q m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> QueryT t q m ())
-> (Event t (Performable m ()) -> m ())
-> Event t (Performable m ())
-> QueryT t q m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Performable m ()) -> m ()
forall t (m :: * -> *).
PerformEvent t m =>
Event t (Performable m ()) -> m ()
performEvent_
  performEvent :: Event t (Performable (QueryT t q m) a) -> QueryT t q m (Event t a)
performEvent = m (Event t a) -> QueryT t q m (Event t a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t a) -> QueryT t q m (Event t a))
-> (Event t (Performable m a) -> m (Event t a))
-> Event t (Performable m a)
-> QueryT t q m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Performable m a) -> m (Event t a)
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent

instance MonadRef m => MonadRef (QueryT t q m) where
  type Ref (QueryT t q m) = Ref m
  newRef :: a -> QueryT t q m (Ref (QueryT t q m) a)
newRef = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (Ref m a)
-> QueryT t q m (Ref m a)
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (Ref m a)
 -> QueryT t q m (Ref m a))
-> (a
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         (Ref m a))
-> a
-> QueryT t q m (Ref m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (Ref m a)
forall (m :: * -> *) a. MonadRef m => a -> m (Ref m a)
newRef
  readRef :: Ref (QueryT t q m) a -> QueryT t q m a
readRef = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   a
 -> QueryT t q m a)
-> (Ref m a
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         a)
-> Ref m a
-> QueryT t q m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref m a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
forall (m :: * -> *) a. MonadRef m => Ref m a -> m a
readRef
  writeRef :: Ref (QueryT t q m) a -> a -> QueryT t q m ()
writeRef r :: Ref (QueryT t q m) a
r = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  ()
-> QueryT t q m ()
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   ()
 -> QueryT t q m ())
-> (a
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         ())
-> a
-> QueryT t q m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ref
  (StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m)))
  a
-> a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
forall (m :: * -> *) a. MonadRef m => Ref m a -> a -> m ()
writeRef Ref
  (StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m)))
  a
Ref (QueryT t q m) a
r

instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (QueryT t q m) where
  newEventWithTrigger :: (EventTrigger t a -> IO (IO ())) -> QueryT t q m (Event t a)
newEventWithTrigger = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (Event t a)
-> QueryT t q m (Event t a)
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (Event t a)
 -> QueryT t q m (Event t a))
-> ((EventTrigger t a -> IO (IO ()))
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         (Event t a))
-> (EventTrigger t a -> IO (IO ()))
-> QueryT t q m (Event t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EventTrigger t a -> IO (IO ()))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (Event t a)
forall t (m :: * -> *) a.
MonadReflexCreateTrigger t m =>
(EventTrigger t a -> IO (IO ())) -> m (Event t a)
newEventWithTrigger
  newFanEventWithTrigger :: (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> QueryT t q m (EventSelector t k)
newFanEventWithTrigger a :: forall a. k a -> EventTrigger t a -> IO (IO ())
a = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (EventSelector t k)
-> QueryT t q m (EventSelector t k)
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
   (EventSelector t k)
 -> QueryT t q m (EventSelector t k))
-> (EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) m) (EventSelector t k)
    -> StateT
         [Behavior t q]
         (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
         (EventSelector t k))
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (EventSelector t k)
-> QueryT t q m (EventSelector t k)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EventWriterT
  t q (ReaderT (Dynamic t (QueryResult q)) m) (EventSelector t k)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     (EventSelector t k)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventWriterT
   t q (ReaderT (Dynamic t (QueryResult q)) m) (EventSelector t k)
 -> QueryT t q m (EventSelector t k))
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (EventSelector t k)
-> QueryT t q m (EventSelector t k)
forall a b. (a -> b) -> a -> b
$ (forall a. k a -> EventTrigger t a -> IO (IO ()))
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (EventSelector t k)
forall t (m :: * -> *) (k :: * -> *).
(MonadReflexCreateTrigger t m, GCompare k) =>
(forall a. k a -> EventTrigger t a -> IO (IO ()))
-> m (EventSelector t k)
newFanEventWithTrigger forall a. k a -> EventTrigger t a -> IO (IO ())
a

-- TODO: Monoid and Semigroup can likely be derived once StateT has them.
instance (Monoid a, Monad m) => Monoid (QueryT t q m a) where
  mempty :: QueryT t q m a
mempty = a -> QueryT t q m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
  mappend :: QueryT t q m a -> QueryT t q m a -> QueryT t q m a
mappend = QueryT t q m a -> QueryT t q m a -> QueryT t q m a
forall a. Semigroup a => a -> a -> a
(<>)

instance (S.Semigroup a, Monad m) => S.Semigroup (QueryT t q m a) where
  <> :: QueryT t q m a -> QueryT t q m a -> QueryT t q m a
(<>) = (a -> a -> a) -> QueryT t q m a -> QueryT t q m a -> QueryT t q m a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> a -> a
forall a. Semigroup a => a -> a -> a
(S.<>)

-- | withQueryT's QueryMorphism argument needs to be a group homomorphism in order to behave correctly
withQueryT :: (MonadFix m, PostBuild t m, Group q, Group q', Additive q, Additive q', Query q')
           => QueryMorphism q q'
           -> QueryT t q m a
           -> QueryT t q' m a
withQueryT :: QueryMorphism q q' -> QueryT t q m a -> QueryT t q' m a
withQueryT f :: QueryMorphism q q'
f a :: QueryT t q m a
a = do
  Dynamic t (QueryResult q')
r' <- QueryT t q' m (Dynamic t (QueryResult q'))
forall t q (m :: * -> *).
MonadQuery t q m =>
m (Dynamic t (QueryResult q))
askQueryResult
  (result :: a
result, q :: Incremental t (AdditivePatch q)
q) <- m (a, Incremental t (AdditivePatch q))
-> QueryT t q' m (a, Incremental t (AdditivePatch q))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, Incremental t (AdditivePatch q))
 -> QueryT t q' m (a, Incremental t (AdditivePatch q)))
-> m (a, Incremental t (AdditivePatch q))
-> QueryT t q' m (a, Incremental t (AdditivePatch q))
forall a b. (a -> b) -> a -> b
$ QueryT t q m a
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
forall (m :: * -> *) q t a.
(MonadFix m, Additive q, Group q, Reflex t) =>
QueryT t q m a
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
runQueryT QueryT t q m a
a (Dynamic t (QueryResult q)
 -> m (a, Incremental t (AdditivePatch q)))
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
forall a b. (a -> b) -> a -> b
$ QueryMorphism q q' -> QueryResult q' -> QueryResult q
forall q q'. QueryMorphism q q' -> QueryResult q' -> QueryResult q
mapQueryResult QueryMorphism q q'
f (QueryResult q' -> QueryResult q)
-> Dynamic t (QueryResult q') -> Dynamic t (QueryResult q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Dynamic t (QueryResult q')
r'
  Incremental t (AdditivePatch q') -> QueryT t q' m ()
forall t q (m :: * -> *).
MonadQuery t q m =>
Incremental t (AdditivePatch q) -> m ()
tellQueryIncremental (Incremental t (AdditivePatch q') -> QueryT t q' m ())
-> Incremental t (AdditivePatch q') -> QueryT t q' m ()
forall a b. (a -> b) -> a -> b
$ PullM t (PatchTarget (AdditivePatch q'))
-> Event t (AdditivePatch q') -> Incremental t (AdditivePatch q')
forall k (t :: k) p.
(Reflex t, Patch p) =>
PullM t (PatchTarget p) -> Event t p -> Incremental t p
unsafeBuildIncremental
    ((q -> q') -> PullM t q -> PullM t q'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (QueryMorphism q q' -> q -> q'
forall q q'. QueryMorphism q q' -> q -> q'
mapQuery QueryMorphism q q'
f) (Behavior t q -> PullM t q
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Incremental t (AdditivePatch q)
-> Behavior t (PatchTarget (AdditivePatch q))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (AdditivePatch q)
q)))
    ((AdditivePatch q -> AdditivePatch q')
-> Event t (AdditivePatch q) -> Event t (AdditivePatch q')
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap (q' -> AdditivePatch q'
forall p. p -> AdditivePatch p
AdditivePatch (q' -> AdditivePatch q')
-> (AdditivePatch q -> q') -> AdditivePatch q -> AdditivePatch q'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. QueryMorphism q q' -> q -> q'
forall q q'. QueryMorphism q q' -> q -> q'
mapQuery QueryMorphism q q'
f (q -> q') -> (AdditivePatch q -> q) -> AdditivePatch q -> q'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AdditivePatch q -> q
forall p. AdditivePatch p -> p
unAdditivePatch) (Event t (AdditivePatch q) -> Event t (AdditivePatch q'))
-> Event t (AdditivePatch q) -> Event t (AdditivePatch q')
forall a b. (a -> b) -> a -> b
$ Incremental t (AdditivePatch q) -> Event t (AdditivePatch q)
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Event t p
updatedIncremental Incremental t (AdditivePatch q)
q)
  a -> QueryT t q' m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result

-- | Maps a function over a 'QueryT' that can change the underlying monad
mapQueryT :: (forall b. m b -> n b) -> QueryT t q m a -> QueryT t q n a
mapQueryT :: (forall b. m b -> n b) -> QueryT t q m a -> QueryT t q n a
mapQueryT f :: forall b. m b -> n b
f (QueryT a :: StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
a) = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) n))
  a
-> QueryT t q n a
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (StateT
   [Behavior t q]
   (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) n))
   a
 -> QueryT t q n a)
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) n))
     a
-> QueryT t q n a
forall a b. (a -> b) -> a -> b
$ (EventWriterT
   t q (ReaderT (Dynamic t (QueryResult q)) m) (a, [Behavior t q])
 -> EventWriterT
      t q (ReaderT (Dynamic t (QueryResult q)) n) (a, [Behavior t q]))
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     a
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) n))
     a
forall (m :: * -> *) a s (n :: * -> *) b.
(m (a, s) -> n (b, s)) -> StateT s m a -> StateT s n b
mapStateT ((forall x.
 ReaderT (Dynamic t (QueryResult q)) m x
 -> ReaderT (Dynamic t (QueryResult q)) n x)
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) m) (a, [Behavior t q])
-> EventWriterT
     t q (ReaderT (Dynamic t (QueryResult q)) n) (a, [Behavior t q])
forall (m :: * -> *) (n :: * -> *) t w a.
(forall x. m x -> n x)
-> EventWriterT t w m a -> EventWriterT t w n a
mapEventWriterT ((m x -> n x)
-> ReaderT (Dynamic t (QueryResult q)) m x
-> ReaderT (Dynamic t (QueryResult q)) n x
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT m x -> n x
forall b. m b -> n b
f)) StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
a

-- | dynWithQueryT's (Dynamic t QueryMorphism) argument needs to be a group homomorphism at all times in order to behave correctly
dynWithQueryT :: (MonadFix m, PostBuild t m, Group q, Additive q, Group q', Additive q', Query q')
           => Dynamic t (QueryMorphism q q')
           -> QueryT t q m a
           -> QueryT t q' m a
dynWithQueryT :: Dynamic t (QueryMorphism q q') -> QueryT t q m a -> QueryT t q' m a
dynWithQueryT f :: Dynamic t (QueryMorphism q q')
f q :: QueryT t q m a
q = do
  Dynamic t (QueryResult q')
r' <- QueryT t q' m (Dynamic t (QueryResult q'))
forall t q (m :: * -> *).
MonadQuery t q m =>
m (Dynamic t (QueryResult q))
askQueryResult
  (result :: a
result, q' :: Incremental t (AdditivePatch q)
q') <- m (a, Incremental t (AdditivePatch q))
-> QueryT t q' m (a, Incremental t (AdditivePatch q))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (a, Incremental t (AdditivePatch q))
 -> QueryT t q' m (a, Incremental t (AdditivePatch q)))
-> m (a, Incremental t (AdditivePatch q))
-> QueryT t q' m (a, Incremental t (AdditivePatch q))
forall a b. (a -> b) -> a -> b
$ QueryT t q m a
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
forall (m :: * -> *) q t a.
(MonadFix m, Additive q, Group q, Reflex t) =>
QueryT t q m a
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
runQueryT QueryT t q m a
q (Dynamic t (QueryResult q)
 -> m (a, Incremental t (AdditivePatch q)))
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
forall a b. (a -> b) -> a -> b
$ (QueryMorphism q q' -> QueryResult q' -> QueryResult q)
-> Dynamic t (QueryMorphism q q')
-> Dynamic t (QueryResult q')
-> Dynamic t (QueryResult q)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
zipDynWith QueryMorphism q q' -> QueryResult q' -> QueryResult q
forall q q'. QueryMorphism q q' -> QueryResult q' -> QueryResult q
mapQueryResult Dynamic t (QueryMorphism q q')
f Dynamic t (QueryResult q')
r'
  Incremental t (AdditivePatch q') -> QueryT t q' m ()
forall t q (m :: * -> *).
MonadQuery t q m =>
Incremental t (AdditivePatch q) -> m ()
tellQueryIncremental (Incremental t (AdditivePatch q') -> QueryT t q' m ())
-> Incremental t (AdditivePatch q') -> QueryT t q' m ()
forall a b. (a -> b) -> a -> b
$ (QueryMorphism q q' -> q -> q')
-> Dynamic t (QueryMorphism q q')
-> Incremental t (AdditivePatch q)
-> Incremental t (AdditivePatch q')
forall t b a a.
(Reflex t, Group b, Additive a, Additive b) =>
(a -> a -> b)
-> Dynamic t a
-> Incremental t (AdditivePatch a)
-> Incremental t (AdditivePatch b)
zipDynIncrementalWith QueryMorphism q q' -> q -> q'
forall q q'. QueryMorphism q q' -> q -> q'
mapQuery Dynamic t (QueryMorphism q q')
f Incremental t (AdditivePatch q)
q'
  a -> QueryT t q' m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
 where zipDynIncrementalWith :: (a -> a -> b)
-> Dynamic t a
-> Incremental t (AdditivePatch a)
-> Incremental t (AdditivePatch b)
zipDynIncrementalWith g :: a -> a -> b
g da :: Dynamic t a
da ib :: Incremental t (AdditivePatch a)
ib =
         let eab :: Event t (These a (AdditivePatch a))
eab = Event t a
-> Event t (AdditivePatch a) -> Event t (These a (AdditivePatch a))
forall (f :: * -> *) a b.
Semialign f =>
f a -> f b -> f (These a b)
align (Dynamic t a -> Event t a
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t a
da) (Incremental t (AdditivePatch a) -> Event t (AdditivePatch a)
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Event t p
updatedIncremental Incremental t (AdditivePatch a)
ib)
             ec :: Event t (AdditivePatch b)
ec = ((These a (AdditivePatch a) -> PushM t (Maybe (AdditivePatch b)))
 -> Event t (These a (AdditivePatch a))
 -> Event t (AdditivePatch b))
-> Event t (These a (AdditivePatch a))
-> (These a (AdditivePatch a) -> PushM t (Maybe (AdditivePatch b)))
-> Event t (AdditivePatch b)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (These a (AdditivePatch a) -> PushM t (Maybe (AdditivePatch b)))
-> Event t (These a (AdditivePatch a)) -> Event t (AdditivePatch b)
forall k (t :: k) a b.
Reflex t =>
(a -> PushM t (Maybe b)) -> Event t a -> Event t b
push Event t (These a (AdditivePatch a))
eab ((These a (AdditivePatch a) -> PushM t (Maybe (AdditivePatch b)))
 -> Event t (AdditivePatch b))
-> (These a (AdditivePatch a) -> PushM t (Maybe (AdditivePatch b)))
-> Event t (AdditivePatch b)
forall a b. (a -> b) -> a -> b
$ \case
                 This a :: a
a -> do
                   a
aOld <- Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t a -> PushM t a) -> Behavior t a -> PushM 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
da
                   a
b <- Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t a -> PushM t a) -> Behavior t a -> PushM t a
forall a b. (a -> b) -> a -> b
$ Incremental t (AdditivePatch a)
-> Behavior t (PatchTarget (AdditivePatch a))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (AdditivePatch a)
ib
                   Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b)))
-> Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b))
forall a b. (a -> b) -> a -> b
$ AdditivePatch b -> Maybe (AdditivePatch b)
forall a. a -> Maybe a
Just (AdditivePatch b -> Maybe (AdditivePatch b))
-> AdditivePatch b -> Maybe (AdditivePatch b)
forall a b. (a -> b) -> a -> b
$ b -> AdditivePatch b
forall p. p -> AdditivePatch p
AdditivePatch (a -> a -> b
g a
a a
b b -> b -> b
forall q. Group q => q -> q -> q
~~ a -> a -> b
g a
aOld a
b)
                 That (AdditivePatch b :: a
b) -> do
                   a
a <- Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t a -> PushM t a) -> Behavior t a -> PushM 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
da
                   Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b)))
-> Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b))
forall a b. (a -> b) -> a -> b
$ AdditivePatch b -> Maybe (AdditivePatch b)
forall a. a -> Maybe a
Just (AdditivePatch b -> Maybe (AdditivePatch b))
-> AdditivePatch b -> Maybe (AdditivePatch b)
forall a b. (a -> b) -> a -> b
$ b -> AdditivePatch b
forall p. p -> AdditivePatch p
AdditivePatch (b -> AdditivePatch b) -> b -> AdditivePatch b
forall a b. (a -> b) -> a -> b
$ a -> a -> b
g a
a a
b
                 These a :: a
a (AdditivePatch b :: a
b) -> do
                   a
aOld <- Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t a -> PushM t a) -> Behavior t a -> PushM 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
da
                   a
bOld <- Behavior t a -> PushM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Behavior t a -> PushM t a) -> Behavior t a -> PushM t a
forall a b. (a -> b) -> a -> b
$ Incremental t (AdditivePatch a)
-> Behavior t (PatchTarget (AdditivePatch a))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (AdditivePatch a)
ib
                   Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b)))
-> Maybe (AdditivePatch b) -> PushM t (Maybe (AdditivePatch b))
forall a b. (a -> b) -> a -> b
$ AdditivePatch b -> Maybe (AdditivePatch b)
forall a. a -> Maybe a
Just (AdditivePatch b -> Maybe (AdditivePatch b))
-> AdditivePatch b -> Maybe (AdditivePatch b)
forall a b. (a -> b) -> a -> b
$ b -> AdditivePatch b
forall p. p -> AdditivePatch p
AdditivePatch (b -> AdditivePatch b) -> b -> AdditivePatch b
forall a b. (a -> b) -> a -> b
$ [b] -> b
forall a. Monoid a => [a] -> a
mconcat [ a -> a -> b
g a
a a
bOld, b -> b
forall q. Group q => q -> q
negateG (a -> a -> b
g a
aOld a
bOld), a -> a -> b
g a
a a
b]
         in PullM t (PatchTarget (AdditivePatch b))
-> Event t (AdditivePatch b) -> Incremental t (AdditivePatch b)
forall k (t :: k) p.
(Reflex t, Patch p) =>
PullM t (PatchTarget p) -> Event t p -> Incremental t p
unsafeBuildIncremental (a -> a -> b
g (a -> a -> b) -> PullM t a -> PullM t (a -> b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior t a -> PullM 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
da) PullM t (a -> b) -> PullM t a -> PullM t b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Behavior t a -> PullM t a
forall k (t :: k) (m :: * -> *) a.
MonadSample t m =>
Behavior t a -> m a
sample (Incremental t (AdditivePatch a)
-> Behavior t (PatchTarget (AdditivePatch a))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (AdditivePatch a)
ib)) Event t (AdditivePatch b)
ec

instance (Monad m, Group q, Additive q, Query q, Reflex t) => MonadQuery t q (QueryT t q m) where
  tellQueryIncremental :: Incremental t (AdditivePatch q) -> QueryT t q m ()
tellQueryIncremental q :: Incremental t (AdditivePatch q)
q = do
    StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  ()
-> QueryT t q m ()
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (([Behavior t q] -> [Behavior t q])
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (Incremental t (AdditivePatch q)
-> Behavior t (PatchTarget (AdditivePatch q))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Behavior t (PatchTarget p)
currentIncremental Incremental t (AdditivePatch q)
qBehavior t q -> [Behavior t q] -> [Behavior t q]
forall a. a -> [a] -> [a]
:))
    StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  ()
-> QueryT t q m ()
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) ()
-> StateT
     [Behavior t q]
     (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
     ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Event t q
-> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) ()
forall t w (m :: * -> *). EventWriter t w m => Event t w -> m ()
tellEvent ((AdditivePatch q -> q) -> Event t (AdditivePatch q) -> Event t q
forall k (t :: k) a b.
Reflex t =>
(a -> b) -> Event t a -> Event t b
fmapCheap AdditivePatch q -> q
forall p. AdditivePatch p -> p
unAdditivePatch (Incremental t (AdditivePatch q) -> Event t (AdditivePatch q)
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Event t p
updatedIncremental Incremental t (AdditivePatch q)
q))))
  askQueryResult :: QueryT t q m (Dynamic t (QueryResult q))
askQueryResult = StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (Dynamic t (QueryResult q))
-> QueryT t q m (Dynamic t (QueryResult q))
forall t q (m :: * -> *) a.
StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  a
-> QueryT t q m a
QueryT StateT
  [Behavior t q]
  (EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m))
  (Dynamic t (QueryResult q))
forall r (m :: * -> *). MonadReader r m => m r
ask
  queryIncremental :: Incremental t (AdditivePatch q)
-> QueryT t q m (Dynamic t (QueryResult q))
queryIncremental q :: Incremental t (AdditivePatch q)
q = do
    Incremental t (AdditivePatch q) -> QueryT t q m ()
forall t q (m :: * -> *).
MonadQuery t q m =>
Incremental t (AdditivePatch q) -> m ()
tellQueryIncremental Incremental t (AdditivePatch q)
q
    (q -> QueryResult q -> QueryResult q)
-> Dynamic t q
-> Dynamic t (QueryResult q)
-> Dynamic t (QueryResult q)
forall k (t :: k) a b c.
Reflex t =>
(a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
zipDynWith q -> QueryResult q -> QueryResult q
forall a. Query a => a -> QueryResult a -> QueryResult a
crop (Incremental t (AdditivePatch q)
-> Dynamic t (PatchTarget (AdditivePatch q))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Dynamic t (PatchTarget p)
incrementalToDynamic Incremental t (AdditivePatch q)
q) (Dynamic t (QueryResult q) -> Dynamic t (QueryResult q))
-> QueryT t q m (Dynamic t (QueryResult q))
-> QueryT t q m (Dynamic t (QueryResult q))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QueryT t q m (Dynamic t (QueryResult q))
forall t q (m :: * -> *).
MonadQuery t q m =>
m (Dynamic t (QueryResult q))
askQueryResult

instance Requester t m => Requester t (QueryT t q m) where
  type Request (QueryT t q m) = Request m
  type Response (QueryT t q m) = Response m
  requesting :: Event t (Request (QueryT t q m) a)
-> QueryT t q m (Event t (Response (QueryT t q m) a))
requesting = m (Event t (Response m a)) -> QueryT t q m (Event t (Response m a))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Event t (Response m a))
 -> QueryT t q m (Event t (Response m a)))
-> (Event t (Request m a) -> m (Event t (Response m a)))
-> Event t (Request m a)
-> QueryT t q m (Event t (Response m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m (Event t (Response m a))
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m (Event t (Response m a))
requesting
  requesting_ :: Event t (Request (QueryT t q m) a) -> QueryT t q m ()
requesting_ = m () -> QueryT t q m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> QueryT t q m ())
-> (Event t (Request m a) -> m ())
-> Event t (Request m a)
-> QueryT t q m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t (Request m a) -> m ()
forall t (m :: * -> *) a.
Requester t m =>
Event t (Request m a) -> m ()
requesting_

instance EventWriter t w m => EventWriter t w (QueryT t q m) where
  tellEvent :: Event t w -> QueryT t q m ()
tellEvent = m () -> QueryT t q m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> QueryT t q m ())
-> (Event t w -> m ()) -> Event t w -> QueryT t q m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event t w -> m ()
forall t w (m :: * -> *). EventWriter t w m => Event t w -> m ()
tellEvent

instance DynamicWriter t w m => DynamicWriter t w (QueryT t q m) where
  tellDyn :: Dynamic t w -> QueryT t q m ()
tellDyn = m () -> QueryT t q m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> QueryT t q m ())
-> (Dynamic t w -> m ()) -> Dynamic t w -> QueryT t q m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dynamic t w -> m ()
forall t w (m :: * -> *).
DynamicWriter t w m =>
Dynamic t w -> m ()
tellDyn