{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
-- |
-- Copyright   : (C) Keera Studios Ltd, 2013
-- License     : BSD3
-- Maintainer  : support@keera.co.uk
--
-- /Reactive Values/ (RVs) are typed mutable variables with a change
-- notification mechanism. They are defined by providing a way to /read/ the
-- value, a way to /change/ it, and a way to install an /react/ when the value
-- has changed.
--
-- RVs are abstract (i.e., a type class). This module defines a class and
-- manipulation operations, but you need an actual instance of RV underneath.
-- For a way to turn 'IORef's into RVs, see the example below. GUI toolkits can
-- use existing event-handling mechanisms to make widget attributes Reactive
-- Values without additional boilerplate. A number of
-- <https://github.com/keera-studios/keera-hails backends> (GUIs, devices,
-- files, network, FRP) are supported.
--
-- RVs are complemented with /Reactive Relations/, which connect RVs and keep
-- them /in sync/ during execution.
--
-- A very simple example of an RV is the following construction, in
-- which passive IORefs are turned into active Reactive Values.
--
-- @
-- import Control.Concurrent (threadDelay)
-- import Control.Monad      (forever)
--
-- -- From the package keera-callbacks
-- import Data.CBRef         (installCallbackCBRef, newCBRef, readCBRef,
--                            writeCBRef)
--
-- -- From keera-hails-reactivevalues
-- import Data.ReactiveValue (ReactiveFieldReadWrite (..), ReactiveFieldWrite,
--                            reactiveValueModify, wrapMW, (=:>))
--
-- main :: IO ()
-- main = do
--
--   -- Empower IORef with callback installation mechanism
--   --
--   -- passiveCBRef :: CBRRef Integer
--   passiveCBRef <- newCBRef 0
--
--   -- Turn IORef into active reactive value (RV).
--   --
--   -- We use the type of Reactive Fields, which have a trivial RV
--   -- implementation.
--   let activeCBRefRV :: ReactiveFieldReadWrite IO Integer
--       activeCBRefRV = ReactiveFieldReadWrite
--                         (writeCBRef           passiveCBRef)
--                         (readCBRef            passiveCBRef)
--                         (installCallbackCBRef passiveCBRef)
--
--   -- Define a write-only RV that prints whatever you put in it.
--   let printer :: Show a => ReactiveFieldWrite IO a
--       printer = wrapMW print
--
--   -- Connect them using a reactive rule. In a GUI application, this code
--   -- would in the controller, and would define connections between the model
--   -- and the view.
--   --
--   -- For bi-directional connections, see (=:=).
--   activeCBRefRV =:> printer
--
--   -- To demonstrate the connection, just loop forever and increment the
--   -- first reactive value. The change will propagate through the channel
--   -- and be printed on the screen every second.
--   forever $ do
--     threadDelay 1000000 -- 1 second
--     reactiveValueModify activeCBRefRV (+1)
-- @
--
-- For further explanations on reactive values, see the
-- <http://dl.acm.org/citation.cfm?id=2804316 Haskell Symposium paper> and
-- <https://github.com/keera-studios/keera-hails/tree/develop/demos the demos>
-- in our repository.
module Data.ReactiveValue
    ( -- * Reactive Values
      -- $rvs

      -- ** Readable Reactive Values
      -- $readablervs
      ReactiveValueRead(..)

      -- ** Writable Reactive Values

      -- $writablervs
    , ReactiveValueWrite(..)

      -- ** Read-Write Reactive Values

      -- $readwritervs
    , ReactiveValueReadWrite

      -- * Reactive Relations or Rules

      -- $rules
    , (=:>)
    , (=:=)
    , (<:=)


      -- * Reactive Fields (pure RVs)

      -- $fields
    , ReactiveFieldRead(..)
    , ReactiveFieldWrite(..)
    , ReactiveFieldReadWrite(..)

      -- $settersgetters
    , FieldGetter
    , FieldSetter
    , FieldNotifier

      -- * RV creation and manipulation

      -- ** Readable RVs

      -- $readablecombinators
    , constR
    , initRW
    , liftR
    , (<^>)
    , liftR2
    , liftR3
    , liftMR
    , readOnly
    , wrapMR
    , wrapMRPassive
    , eventR
    , lMerge
    , rMerge

      -- ** Writable RVs

      -- $writablecombinators
    , constW
    , liftW
    , liftW2
    , (&.&)
    , liftMW
    , writeOnly
    , wrapMW
    , wrapDo
    , wrapDo_


      -- ** Read-write RVs

      -- $readwritecombinators
    , liftRW
    , liftRW2
    , pairRW
    , modRW

      -- **** Bijective functions
    , BijectiveFunc
    , bijection
    , direct
    , inverse
    , Involution
    , involution

      -- **** Low-level operations
    , reactiveValueModify


      -- * Controlling change

      -- $changecontrol

      -- ** Stopping change propagation
    , eqCheck
    , passivelyR
    , passivelyRW

      -- ** Governing
    , governingR
    , governingRW

      -- ** Guarding
    , ifRW
    , ifRW_
    , guardRO
    , guardRO'

      -- * Activatable RVs

      -- $activatable
    , ReactiveValueActivatable(..)
    , ReactiveFieldActivatable
    , mkActivatable
    )
  where

-- External imports
import Control.Monad              (liftM, void, when)
import Data.Functor.Contravariant (Contravariant (contramap))

-- Internal imports
import Control.GFunctor (GFunctor (gmap))

-- $rvs
--
-- Reactive Values are an abstraction over values that change over the execution
-- of a program, and whose change we can be aware of.
--
-- There is no unique, canonical implementation of RVs: they are defined as
-- a collection of type classes, and you are free to make your existing
-- framework reactive by providing the necessary instances.
--
-- RVs are distinguished by the API they offer, mainly whether it is possible
-- to read them, to write to them, or both. A /readable/ RV is one that whose
-- value we can read (whether it is read-only or read-write, or whether it will
-- actively propagate changes to it or not, is a different matter). Analogously,
-- a /writable/ RV is one that we can write to (write-only or read-write).
--
-- We also distinguish between /active/ RVs (i.e., those that actively propagate
-- changes through the Reactive Relations they are connected to) and /passive/
-- RVs (those that do not propagate changes). It is possible to "silence" an
-- RV by minimizing unnecesssary change, or attaching it to another RV that
-- determines when change propagates (see governing and guarding below).

-- $readablervs
--
-- Readable reactive values are mutable values that can be read and, possibly,
-- trigger notifications when they change.
--
-- RVs without event handling are considered /passive/. That is their default
-- behaviour if 'reactiveValueOnCanRead' is not specialised.
-- BEWARE: Active and passive RVs are not differentiated at the type level.
--
-- You are responsible of installing any potential thread-safety
-- mechanisms when you implement instances, and to ensure that operations
-- are executed in the right thread (some GUI toolkits may require that).
-- It is important that the way that ensured that monadic actions are
-- executed in the right thread can be nested; otherwise, some propagation can
-- block.

-- | A class for all Readable RVs. They can be read-only or read-write.
--
-- If your type is also writeable (a writable RV or simply if it is not
-- constant), you can include a change handler installer here. By default
-- no change handlers are installed.
--
-- Use a monad with "error" if reading or installing a handler can fail.
class Monad m => ReactiveValueRead a b m | a -> b, a -> m where

  -- | Install a handler that will be executed when the reactive value
  -- changes.
  reactiveValueOnCanRead :: a -> m () -> m ()
  reactiveValueOnCanRead a
_ m ()
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  -- | Provide the last known value for this reactive value.
  reactiveValueRead :: a -> m b

  {-# MINIMAL reactiveValueRead #-}

-- | Monadic actions are readable, but they do not provide any change
-- notification.
instance ReactiveValueRead (IO a) a IO where
  -- | Executes the monadic action and provides a value.
  reactiveValueRead :: IO a -> IO a
reactiveValueRead = IO a -> IO a
forall a. a -> a
id

-- | Pairs carrying a monadic action as their first component are Readable RVs.
instance (Functor m, Monad m) => ReactiveValueRead (m a, a -> m b) a m where
  reactiveValueRead :: (m a, a -> m b) -> m a
reactiveValueRead = (m a, a -> m b) -> m a
forall a b. (a, b) -> a
fst

-- $writablervs
--
-- Writable reactive values are those that we can write to. They behave like
-- sinks: there are no guarantees that anything happens, or result codes.
--
-- You are responsible of installing any potential thread-safety mechanisms
-- when you implement instances, and to ensure that operations are executed in
-- the right thread (some GUI toolkits may require that). It is important that
-- the way that ensured that monadic actions are executed in the right thread
-- can be nested; otherwise, some propagation can block.

-- | A minimal type class for all mutable values. Use a monad with error if
-- changing the value can fail.
class ReactiveValueWrite a b m | a -> b, a -> m where
  reactiveValueWrite :: a -> b -> m ()

-- | Monadic actions are trivially writable RVs in that monad, by ignoring the
-- argument and executing the action. This is particularly suitable for IO code
-- that just runs an action when a given value changes.
instance ReactiveValueWrite (IO a) () IO where
  reactiveValueWrite :: IO a -> () -> IO ()
reactiveValueWrite IO a
m ()
_ = IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
m

-- | Monadic actions parameterised over an input are trivially writable RVs in
-- that monad. This is particularly suitable for IO code that just runs an
-- action when a given value changes, using that value.
instance (Functor m, Monad m) => ReactiveValueWrite (a -> m b) a m where
  reactiveValueWrite :: (a -> m b) -> a -> m ()
reactiveValueWrite a -> m b
f a
v = m b -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (a -> m b
f a
v)

-- | To facilitate creating RW reactive values from monadic actions, pairs
-- of a getter and a setter are also RVs.
instance ReactiveValueWrite (a -> m b) a m
      => ReactiveValueWrite (m a, a -> m b) a m
  where
    reactiveValueWrite :: (m a, a -> m b) -> a -> m ()
reactiveValueWrite (m a
_, a -> m b
f) = (a -> m b) -> a -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a -> m b
f

-- $readwritervs
--
-- RVs can be readable and writable, which is useful to create bi-directional
-- rules (combinators like '(=:=)' require this instance).
--

-- | Read-write Reactive Values are trivially defined. This class only captures
-- the constraints of both the other classes. There is no need to implement any
-- methods.
class (ReactiveValueRead a b m, ReactiveValueWrite a b m)
   => ReactiveValueReadWrite a b m

-- | Pairs of a monadic action and a parametric monadic action are also RVs
instance (Functor m, Monad m) => ReactiveValueReadWrite (m a, a -> m b) a m

-- $activatable
--
-- Activatable RVs are values that never hold any data, but whose change (or
-- activation, or some sort of internal event) we need to be aware of).

-- | A class for things with a trivial field that carries unit. Buttons (in any
-- GUI library), for instance, could be a member of this class.
class ReactiveValueActivatable m a where
   defaultActivation :: a -> ReactiveFieldActivatable m

-- $rules
--
-- Reactive Rules are data dependency (data-passing) building combinators. By
-- executing them, you install the right event handlers on the right RVs, so
-- that values pass to the other RV.
--
-- Reactive Relations cannot be independently removed. If the event-dispatching
-- is handled internally by RVs, and two connected RVs are removed, then the
-- rules should also disappear with them.

-- Priorities so that we can write them infix without parenthesising
infix 9 =:=
infix 9 =:>
infix 9 <:=

-- | Left to right RV synchronisation function. If the value on the left
-- changes, the one on the right is updated accordingly.
(=:>) :: Monad m
      => (ReactiveValueRead a b m, ReactiveValueWrite c b m)
      => a
      -> c
      -> m ()
=:> :: a -> c -> m ()
(=:>) a
v1 c
v2 = a -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
v1 m ()
sync1
  where
    sync1 :: m ()
sync1 = a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
v1 m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite c
v2

-- | Right-to-left RV synchronisation function. If the value on the right
-- changes, the one on the left is updated accordingly.
(<:=) :: Monad m
      => (ReactiveValueRead a b m, ReactiveValueWrite c b m)
      => c
      -> a
      -> m ()
<:= :: c -> a -> m ()
(<:=) c
v2 a
v1 = a -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
v1 m ()
sync1
  where
    sync1 :: m ()
sync1 = a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
v1 m b -> (b -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= c -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite c
v2

-- | Bidirectional synchronisation. When either value changes, the other
-- is updated accordingly.
(=:=) :: Monad m
      => (ReactiveValueReadWrite a b m, ReactiveValueReadWrite c b m)
      => a
      -> c
      -> m ()
=:= :: a -> c -> m ()
(=:=) a
v1 c
v2 = do
  -- This is often async, so the fact that one comes before the other does not
  -- guarantee that they will be refreshed in that order.
  a
v1 a -> c -> m ()
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueRead a b m, ReactiveValueWrite c b m) =>
a -> c -> m ()
=:> c
v2
  a
v1 a -> c -> m ()
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueRead a b m, ReactiveValueWrite c b m) =>
c -> a -> m ()
<:= c
v2

-- $fields
-- This is a specific implementation of RVs that does not have a custom event
-- queue.
--
-- It can be used to return RVs in the combinators, by relying on the underlying
-- change detection and event notification system (underlying meaning or the RV
-- that these were created from).

-- | A Read-Only RV.
data ReactiveFieldRead m a =
  ReactiveFieldRead (FieldGetter m a) (FieldNotifier m a)

-- | A Write-Only RV.
newtype ReactiveFieldWrite m a =
  ReactiveFieldWrite (FieldSetter m a)

-- | A Read-Write RV.
data ReactiveFieldReadWrite m a =
  ReactiveFieldReadWrite (FieldSetter m a) (FieldGetter m a) (FieldNotifier m a)

-- | A trivial type for Readable RVs that carry unit. They can be used for
-- buttons, or events without data.
type ReactiveFieldActivatable m = ReactiveFieldRead m ()

instance Monad m => ReactiveValueRead (ReactiveFieldRead m a) a m where
  reactiveValueOnCanRead :: ReactiveFieldRead m a -> m () -> m ()
reactiveValueOnCanRead (ReactiveFieldRead m a
_ m () -> m ()
notifier) = m () -> m ()
notifier
  reactiveValueRead :: ReactiveFieldRead m a -> m a
reactiveValueRead (ReactiveFieldRead m a
getter m () -> m ()
_)        = m a
getter

instance Monad m => ReactiveValueWrite (ReactiveFieldWrite m a) a m where
  reactiveValueWrite :: ReactiveFieldWrite m a -> a -> m ()
reactiveValueWrite (ReactiveFieldWrite a -> m ()
setter) = a -> m ()
setter

instance Monad m => ReactiveValueRead (ReactiveFieldReadWrite m a) a m where
  reactiveValueOnCanRead :: ReactiveFieldReadWrite m a -> m () -> m ()
reactiveValueOnCanRead (ReactiveFieldReadWrite FieldSetter m a
_ m a
_ m () -> m ()
notifier) = m () -> m ()
notifier
  reactiveValueRead :: ReactiveFieldReadWrite m a -> m a
reactiveValueRead (ReactiveFieldReadWrite FieldSetter m a
_ m a
getter m () -> m ()
_)        = m a
getter

instance Monad m => ReactiveValueWrite (ReactiveFieldReadWrite m a) a m where
  reactiveValueWrite :: ReactiveFieldReadWrite m a -> a -> m ()
reactiveValueWrite (ReactiveFieldReadWrite a -> m ()
setter FieldGetter m a
_ FieldNotifier m a
_) = a -> m ()
setter

instance Monad m => ReactiveValueReadWrite (ReactiveFieldReadWrite m a) a m

-- $settersgetters
--
-- These are used internally for combinators that need to return RV instances.
-- They can also be used to write new backends and library extensions, but they
-- are not recommended to enclose application models. For that purpose, see
-- light models and protected models instead.

-- | The type of a monadic value producer (a getter, a source).
type FieldGetter m a   = m a

-- | The type of a monadic value consumer (a setter, a sink, a slot).
type FieldSetter m a   = a -> m ()

-- | The type of an event handler installer
type FieldNotifier m a = m () -> m ()

-- | Create an activatable RV from a handler installer.
mkActivatable :: Monad m => (m () -> m ()) -> ReactiveFieldActivatable m
mkActivatable :: (m () -> m ()) -> ReactiveFieldActivatable m
mkActivatable m () -> m ()
f = m () -> (m () -> m ()) -> ReactiveFieldActivatable m
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead m ()
getter m () -> m ()
notifier
  where
    getter :: m ()
getter   = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    notifier :: m () -> m ()
notifier = m () -> m ()
f

-- $readablecombinators

-- | A trivial RV builder with a constant value. We need this because we cannot
-- have overlapping instances with a default case, and because the
-- interpretation of lifting with RVs could be very confusing unless values are
-- lifted into RVs explicitly.
constR :: Monad m => a ->  ReactiveFieldRead m a
constR :: a -> ReactiveFieldRead m a
constR a
e = FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m a
getter FieldNotifier m a
forall (m :: * -> *) p. Monad m => p -> m ()
notifier
  where
    notifier :: p -> m ()
notifier p
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    getter :: FieldGetter m a
getter     = a -> FieldGetter m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e

{-# DEPRECATED initRW "Deprecated in keera-hails-reactivevalues 0.8.0, use constR instead" #-}
-- | A trivial RV builder with a constant value (i.e., initialized). We need
-- this because we cannot have overlapping instances with a default case, and
-- because the interpretation of lifting with RVs could be very confusing
-- unless values are lifted into RVs explicitly.
initRW :: Monad m => a ->  ReactiveFieldRead m a
initRW :: a -> ReactiveFieldRead m a
initRW a
e = FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m a
getter FieldNotifier m a
forall (m :: * -> *) p. Monad m => p -> m ()
notifier
  where
    notifier :: p -> m ()
notifier p
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    getter :: FieldGetter m a
getter     = a -> FieldGetter m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e

{-# ANN liftR "HLint: ignore Use fmap" #-}
-- | Lift a transformation onto a RV. Note that this creates a new
-- RV, it does not modify the existing RV.
liftR :: (Monad m, ReactiveValueRead a b m)
      => (b -> c)
      -> a
      -> ReactiveFieldRead m c
liftR :: (b -> c) -> a -> ReactiveFieldRead m c
liftR b -> c
f a
e = FieldGetter m c -> FieldNotifier m c -> ReactiveFieldRead m c
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m c
getter FieldNotifier m c
notifier
  where
    notifier :: FieldNotifier m c
notifier = a -> FieldNotifier m c
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
e
    getter :: FieldGetter m c
getter   = (b -> c) -> m b -> FieldGetter m c
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> c
f (a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
e)

-- | Shorter name for 'liftR'
(<^>) :: (Monad m, ReactiveValueRead a b m)
      => (b -> c)
      -> a
      -> ReactiveFieldRead m c
<^> :: (b -> c) -> a -> ReactiveFieldRead m c
(<^>) = (b -> c) -> a -> ReactiveFieldRead m c
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueRead a b m) =>
(b -> c) -> a -> ReactiveFieldRead m c
liftR

-- | Lift a transformation onto two RVs. Note that this creates a new RV, it
-- does not modify the existing RVs. When either RV changes, the new one
-- triggers a change.
liftR2 :: (Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m)
       => (b -> d -> e) -> a -> c -> ReactiveFieldRead m e
liftR2 :: (b -> d -> e) -> a -> c -> ReactiveFieldRead m e
liftR2 b -> d -> e
f a
e1 c
e2 = FieldGetter m e -> FieldNotifier m e -> ReactiveFieldRead m e
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m e
getter FieldNotifier m e
forall (m :: * -> *) b b.
(ReactiveValueRead a b m, ReactiveValueRead c b m) =>
m () -> m ()
notifier
  where
    getter :: FieldGetter m e
getter = do b
v1 <- a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
e1
                d
v2 <- c -> m d
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
e2
                e -> FieldGetter m e
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> d -> e
f b
v1 d
v2)
    notifier :: m () -> m ()
notifier m ()
p = do a -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
e1 m ()
p
                    c -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead c
e2 m ()
p

-- | Lift a transformation onto three RVs. Note that this creates a new RV, it
-- does not modify the existing RVs. When either RV changes, the new one
-- triggers a change.
liftR3 :: ( Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m
          , ReactiveValueRead e f m)
       => (b -> d -> f -> g) -> a -> c -> e -> ReactiveFieldRead m g
liftR3 :: (b -> d -> f -> g) -> a -> c -> e -> ReactiveFieldRead m g
liftR3 b -> d -> f -> g
f a
e1 c
e2 e
e3 = FieldGetter m g -> FieldNotifier m g -> ReactiveFieldRead m g
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m g
getter FieldNotifier m g
forall (m :: * -> *) b b b.
(ReactiveValueRead a b m, ReactiveValueRead c b m,
 ReactiveValueRead e b m) =>
m () -> m ()
notifier
  where
    getter :: FieldGetter m g
getter = do b
v1 <- a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
e1
                d
v2 <- c -> m d
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
e2
                f
v3 <- e -> m f
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead e
e3
                g -> FieldGetter m g
forall (m :: * -> *) a. Monad m => a -> m a
return (b -> d -> f -> g
f b
v1 d
v2 f
v3)
    notifier :: m () -> m ()
notifier m ()
p = do a -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
e1 m ()
p
                    c -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead c
e2 m ()
p
                    e -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead e
e3 m ()
p

-- | Lift a parameterised monadic transformation onto an RV.
--
-- Same as lifting join . f?
liftMR :: (Monad m, ReactiveValueRead a b m)
       => (b -> m c)
       -> a
       -> ReactiveFieldRead m c
liftMR :: (b -> m c) -> a -> ReactiveFieldRead m c
liftMR b -> m c
f a
e = m c -> FieldNotifier m c -> ReactiveFieldRead m c
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead m c
getter FieldNotifier m c
notifier
  where
    notifier :: FieldNotifier m c
notifier = a -> FieldNotifier m c
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
e
    getter :: m c
getter   = b -> m c
f (b -> m c) -> m b -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
e

-- *** Lifting (source) computations into readable RVs.

{-# ANN wrapMR "HLint: ignore Eta reduce" #-}
-- | Wrap an reading operation and an notification installer in a readable
-- reactive value.
wrapMR :: m a -> (m () -> m ()) -> ReactiveFieldRead m a
wrapMR :: m a -> (m () -> m ()) -> ReactiveFieldRead m a
wrapMR m a
f m () -> m ()
p = m a -> (m () -> m ()) -> ReactiveFieldRead m a
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead m a
f m () -> m ()
p

-- | Wrap an reading operation into an RV. Because there is no way to detect
-- changes, the resulting RV is passive (does not push updates).
wrapMRPassive :: Monad m => m a -> ReactiveFieldRead m a
wrapMRPassive :: m a -> ReactiveFieldRead m a
wrapMRPassive m a
f = m a -> FieldNotifier m a -> ReactiveFieldRead m a
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead m a
f (m () -> FieldNotifier m a
forall a b. a -> b -> a
const (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()))

{-# ANN eventR "HLint: ignore Eta reduce" #-}
-- | Wrap event-handler installers in RVs
eventR :: Monad m => (m () -> m ()) -> ReactiveFieldRead m ()
eventR :: (m () -> m ()) -> ReactiveFieldRead m ()
eventR m () -> m ()
notifInstaller = m () -> (m () -> m ()) -> ReactiveFieldRead m ()
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead (() -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) m () -> m ()
notifInstaller

-- | Make a RW RV read only
readOnly :: ReactiveValueRead r a m => r -> ReactiveFieldRead m a
readOnly :: r -> ReactiveFieldRead m a
readOnly r
r = FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead (r -> FieldGetter m a
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead r
r) (r -> FieldNotifier m a
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead r
r)

-- $writablecombinators

-- | Create a constant writable RV.
--
constW :: (Monad m, ReactiveValueWrite v a m)
       => a
       -> v
       -> ReactiveFieldWrite m b
constW :: a -> v -> ReactiveFieldWrite m b
constW a
c v
v = FieldSetter m b -> ReactiveFieldWrite m b
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite (FieldSetter m b -> ReactiveFieldWrite m b)
-> FieldSetter m b -> ReactiveFieldWrite m b
forall a b. (a -> b) -> a -> b
$ \b
_ -> v -> a -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite v
v a
c

-- | Lift a transformation onto an RV. This creates a new RV, it does not
-- actually modify the old RV (when this one is written to, so will be the old
-- one, but both will keep existing somewhat independently).
liftW :: (Monad m, ReactiveValueWrite a b m)
      => (c -> b) -> a -> ReactiveFieldWrite m c
liftW :: (c -> b) -> a -> ReactiveFieldWrite m c
liftW c -> b
f a
e = FieldSetter m c -> ReactiveFieldWrite m c
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite FieldSetter m c
setter
  where
    setter :: FieldSetter m c
setter = a -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a
e (b -> m ()) -> (c -> b) -> FieldSetter m c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> b
f

-- | Lift a transformation onto two RVs. This creates a new RV, it does not
-- actually modify the old RVs (when this one is written to, so will be the old
-- ones, but both will keep existing somewhat independently).
liftW2 :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite d e m)
       => (c -> (b, e)) -> a -> d -> ReactiveFieldWrite m c
liftW2 :: (c -> (b, e)) -> a -> d -> ReactiveFieldWrite m c
liftW2 c -> (b, e)
f a
e1 d
e2 = FieldSetter m c -> ReactiveFieldWrite m c
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite FieldSetter m c
forall (m :: * -> *).
(Monad m, ReactiveValueWrite a b m, ReactiveValueWrite d e m) =>
c -> m ()
setter
  where
    setter :: c -> m ()
setter c
x = do let (b
v1, e
v2) = c -> (b, e)
f c
x
                  a -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a
e1 b
v1
                  d -> e -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite d
e2 e
v2

-- | Binary writable replicator.
--
-- r1 &.& r2 = liftW2 (\x -> (x, x)) r1 r2
--
(&.&) :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite c b m)
      => a -> c -> ReactiveFieldWrite m b
&.& :: a -> c -> ReactiveFieldWrite m b
(&.&) a
v1 c
v2 = FieldSetter m b -> ReactiveFieldWrite m b
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite (FieldSetter m b -> ReactiveFieldWrite m b)
-> FieldSetter m b -> ReactiveFieldWrite m b
forall a b. (a -> b) -> a -> b
$ \b
x -> do
  a -> FieldSetter m b
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a
v1 b
x
  c -> FieldSetter m b
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite c
v2 b
x


-- | Lift a parameterised monadic transformation onto an RV.
liftMW :: (Monad m, ReactiveValueWrite a b m)
       => (c -> m b) -> a -> ReactiveFieldWrite m c
liftMW :: (c -> m b) -> a -> ReactiveFieldWrite m c
liftMW c -> m b
f a
e = FieldSetter m c -> ReactiveFieldWrite m c
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite FieldSetter m c
setter
  where
    setter :: FieldSetter m c
setter c
x = a -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a
e (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< c -> m b
f c
x

-- | Make a RW RV write only
writeOnly :: ReactiveValueWrite r a m => r -> ReactiveFieldWrite m a
writeOnly :: r -> ReactiveFieldWrite m a
writeOnly r
r = FieldSetter m a -> ReactiveFieldWrite m a
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite (r -> FieldSetter m a
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite r
r)

-- $readwritecombinators

-- | Wrap a monadic computation in a writable reactive value.
wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a
wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a
wrapMW = (a -> m ()) -> ReactiveFieldWrite m a
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite

-- | Wrap a monadic computation in a writable reactive value. It discards the
-- written value and executes the operation.
--
-- Note: Because the value is discarded, the resulting RV is polymorphic in the
-- value that may be written to it. Using 'wrapDo_' may save you some extra
-- type signatures.
--
-- NOTE: this should be unnecessary since the introduction of a default
-- 'ReactiveValueWrite' instance for monadic actions.
wrapDo :: m () -> ReactiveFieldWrite m a
wrapDo :: m () -> ReactiveFieldWrite m a
wrapDo = (a -> m ()) -> ReactiveFieldWrite m a
forall a (m :: * -> *). (a -> m ()) -> ReactiveFieldWrite m a
wrapMW ((a -> m ()) -> ReactiveFieldWrite m a)
-> (m () -> a -> m ()) -> m () -> ReactiveFieldWrite m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> a -> m ()
forall a b. a -> b -> a
const

-- | Wrap a monadic computation in a writable reactive value of type unit. It
-- discards the written value and executes the operation.
wrapDo_ :: m () -> ReactiveFieldWrite m ()
wrapDo_ :: m () -> ReactiveFieldWrite m ()
wrapDo_ = m () -> ReactiveFieldWrite m ()
forall (m :: * -> *) a. m () -> ReactiveFieldWrite m a
wrapDo

-- Lifting onto read-write values

-- | Bijections
newtype BijectiveFunc a b = BijectiveFunc
  { BijectiveFunc a b -> (a -> b, b -> a)
unBijectiveFunc :: (a -> b, b -> a) }

-- | Create a bijection ('BijectiveFunc') from a couple of functions
bijection :: (a -> b, b -> a) -> BijectiveFunc a b
bijection :: (a -> b, b -> a) -> BijectiveFunc a b
bijection = (a -> b, b -> a) -> BijectiveFunc a b
forall a b. (a -> b, b -> a) -> BijectiveFunc a b
BijectiveFunc

{-# ANN direct "HLint: ignore Redundant bracket" #-}
-- | Obtain the direct function from a bijection
direct :: BijectiveFunc a b -> (a -> b)
direct :: BijectiveFunc a b -> a -> b
direct = (a -> b, b -> a) -> a -> b
forall a b. (a, b) -> a
fst ((a -> b, b -> a) -> a -> b)
-> (BijectiveFunc a b -> (a -> b, b -> a))
-> BijectiveFunc a b
-> a
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BijectiveFunc a b -> (a -> b, b -> a)
forall a b. BijectiveFunc a b -> (a -> b, b -> a)
unBijectiveFunc

{-# ANN inverse "HLint: ignore Redundant bracket" #-}
-- | Obtain the inverse function from a bijection
inverse :: BijectiveFunc a b -> (b -> a)
inverse :: BijectiveFunc a b -> b -> a
inverse = (a -> b, b -> a) -> b -> a
forall a b. (a, b) -> b
snd ((a -> b, b -> a) -> b -> a)
-> (BijectiveFunc a b -> (a -> b, b -> a))
-> BijectiveFunc a b
-> b
-> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BijectiveFunc a b -> (a -> b, b -> a)
forall a b. BijectiveFunc a b -> (a -> b, b -> a)
unBijectiveFunc

-- | Involutions (functions that are the same as their inverse)
type Involution a = BijectiveFunc a a

-- | Create an involution from a function
involution :: (a -> a) -> Involution a
involution :: (a -> a) -> Involution a
involution a -> a
f = (a -> a, a -> a) -> Involution a
forall a b. (a -> b, b -> a) -> BijectiveFunc a b
BijectiveFunc (a -> a
f, a -> a
f)

-- | Lift a bijection onto a read-write RV
liftRW :: (Monad m, ReactiveValueReadWrite a b m)
       => BijectiveFunc b c -> a -> ReactiveFieldReadWrite m c
liftRW :: BijectiveFunc b c -> a -> ReactiveFieldReadWrite m c
liftRW (BijectiveFunc (b -> c
f1, c -> b
f2)) a
e =
    FieldSetter m c
-> FieldGetter m c
-> FieldNotifier m c
-> ReactiveFieldReadWrite m c
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite FieldSetter m c
setter FieldGetter m c
getter FieldNotifier m c
notifier
  where
    ReactiveFieldRead FieldGetter m c
getter FieldNotifier m c
notifier = (b -> c) -> a -> ReactiveFieldRead m c
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueRead a b m) =>
(b -> c) -> a -> ReactiveFieldRead m c
liftR b -> c
f1 a
e
    ReactiveFieldWrite FieldSetter m c
setter         = (c -> b) -> a -> ReactiveFieldWrite m c
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueWrite a b m) =>
(c -> b) -> a -> ReactiveFieldWrite m c
liftW c -> b
f2 a
e

-- | Lift a bijection onto two read-write RVs
liftRW2 :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m)
        => BijectiveFunc e (b, d) -> a -> c -> ReactiveFieldReadWrite m e
liftRW2 :: BijectiveFunc e (b, d) -> a -> c -> ReactiveFieldReadWrite m e
liftRW2 (BijectiveFunc (e -> (b, d)
f1, (b, d) -> e
f2)) a
e1 c
e2 =
    FieldSetter m e
-> FieldGetter m e
-> FieldNotifier m e
-> ReactiveFieldReadWrite m e
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite FieldSetter m e
setter FieldGetter m e
getter FieldNotifier m e
notifier
  where
    ReactiveFieldRead FieldGetter m e
getter FieldNotifier m e
notifier = (b -> d -> e) -> a -> c -> ReactiveFieldRead m e
forall (m :: * -> *) a b c d e.
(Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m) =>
(b -> d -> e) -> a -> c -> ReactiveFieldRead m e
liftR2 (((b, d) -> e) -> b -> d -> e
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (b, d) -> e
f2) a
e1 c
e2
    ReactiveFieldWrite FieldSetter m e
setter         = (e -> (b, d)) -> a -> c -> ReactiveFieldWrite m e
forall (m :: * -> *) a b d e c.
(Monad m, ReactiveValueWrite a b m, ReactiveValueWrite d e m) =>
(c -> (b, e)) -> a -> d -> ReactiveFieldWrite m c
liftW2 e -> (b, d)
f1 a
e1 c
e2

-- | Pair two read-write RVs
pairRW :: (Monad m,
           ReactiveValueReadWrite a b m,
           ReactiveValueReadWrite c d m)
       => a -> c
       -> ReactiveFieldReadWrite m (b, d)
pairRW :: a -> c -> ReactiveFieldReadWrite m (b, d)
pairRW = BijectiveFunc (b, d) (b, d)
-> a -> c -> ReactiveFieldReadWrite m (b, d)
forall (m :: * -> *) a b c d e.
(Monad m, ReactiveValueReadWrite a b m,
 ReactiveValueReadWrite c d m) =>
BijectiveFunc e (b, d) -> a -> c -> ReactiveFieldReadWrite m e
liftRW2 (((b, d) -> (b, d), (b, d) -> (b, d)) -> BijectiveFunc (b, d) (b, d)
forall a b. (a -> b, b -> a) -> BijectiveFunc a b
bijection ((b, d) -> (b, d)
forall a. a -> a
id, (b, d) -> (b, d)
forall a. a -> a
id))

-- | Add an equality check to the setter of a Read-Write RV, effectively
-- stopping all unnecessary change (the RV is not modified if it has not
-- changed).
{-# INLINE eqCheck #-}
eqCheck :: (Eq v, Monad m)
        => ReactiveFieldReadWrite m v
        -> ReactiveFieldReadWrite m v
eqCheck :: ReactiveFieldReadWrite m v -> ReactiveFieldReadWrite m v
eqCheck (ReactiveFieldReadWrite FieldSetter m v
setter FieldGetter m v
getter FieldNotifier m v
notifier) =
    FieldSetter m v
-> FieldGetter m v
-> FieldNotifier m v
-> ReactiveFieldReadWrite m v
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite FieldSetter m v
setter' FieldGetter m v
getter FieldNotifier m v
notifier
  where
    setter' :: FieldSetter m v
setter' v
v = do v
o <- FieldGetter m v
getter
                   Bool -> FieldNotifier m v
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (v
o v -> v -> Bool
forall a. Eq a => a -> a -> Bool
/= v
v) FieldNotifier m v -> FieldNotifier m v
forall a b. (a -> b) -> a -> b
$ FieldSetter m v
setter v
v


-- | Lift a function that takes an old value and a new input and creates a new
-- value. It is similar to how fold works: the RV represents the accumulator,
-- and the values are provided in succession by writing to the resulting RV.
modRW :: (Monad m, ReactiveValueReadWrite a b m)
      => (b -> c -> b) -> a -> ReactiveFieldWrite m c
modRW :: (b -> c -> b) -> a -> ReactiveFieldWrite m c
modRW b -> c -> b
f a
rv = FieldSetter m c -> ReactiveFieldWrite m c
forall (m :: * -> *) a. FieldSetter m a -> ReactiveFieldWrite m a
ReactiveFieldWrite FieldSetter m c
forall (m :: * -> *).
(ReactiveValueRead a b m, ReactiveValueWrite a b m) =>
c -> m ()
setter
  where
    setter :: c -> m ()
setter c
c = do b
b <- a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
rv
                  let b' :: b
b' = b -> c -> b
f b
b c
c
                  a -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a
rv b
b'

-- | Apply a modification to an RV. This modification is not attached to the
-- RV, and there are no guarantees that it will be atomic (if you need
-- atomicity, check out STM).
reactiveValueModify :: (Monad m, ReactiveValueReadWrite a b m)
                    => a
                    -> (b -> b)
                    -> m ()
reactiveValueModify :: a -> (b -> b) -> m ()
reactiveValueModify a
r b -> b
f = a -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a
r (b -> m ()) -> (b -> b) -> b -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> b
f (b -> m ()) -> m b -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
r

{-# ANN lMerge "HLint: ignore Use const" #-}
-- | Left merge (give priority to the value on the left)
lMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m)
       => a -> b -> ReactiveFieldRead m v
lMerge :: a -> b -> ReactiveFieldRead m v
lMerge = (v -> v -> v) -> a -> b -> ReactiveFieldRead m v
forall (m :: * -> *) a b c d e.
(Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m) =>
(b -> d -> e) -> a -> c -> ReactiveFieldRead m e
liftR2 (\v
a v
_ -> v
a)

-- | Right merge (give priority to the value on the right)
rMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m)
       => a -> b -> ReactiveFieldRead m v
rMerge :: a -> b -> ReactiveFieldRead m v
rMerge = (v -> v -> v) -> a -> b -> ReactiveFieldRead m v
forall (m :: * -> *) a b c d e.
(Monad m, ReactiveValueRead a b m, ReactiveValueRead c d m) =>
(b -> d -> e) -> a -> c -> ReactiveFieldRead m e
liftR2 (\v
_ v
b -> v
b)

-- $changecontrol
--
-- Sometimes you need to create complex liftings between RVs in which only
-- changes to one of them should provoke change propagation. These combinators
-- allow you to stop propagation (making RVs passive), make one RV control the
-- change propagation of another (governance), filter propagation based on some
-- condition (guards) and have a boolean-carrying RV guard another.

-- Turning an active RV into a passive one (does not propagate changes). Note
-- that this does not really affect the RV itself, only produces a new RV that
-- will not propagate changes. So, if used in a reactive relation, values will
-- not get propagated when they change. It is useful in combination with lifts,
-- to achieve things similar to Yampa's tagging, but this might be more
-- general.

-- | Create a passive RO RV backed by another Readable RV by disabling change
-- propagation.
passivelyR :: (Monad m, ReactiveValueRead a b m)
           => a -> ReactiveFieldRead m b
passivelyR :: a -> ReactiveFieldRead m b
passivelyR a
rv =
  FieldGetter m b -> FieldNotifier m b -> ReactiveFieldRead m b
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead (a -> FieldGetter m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
rv) (\m ()
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | Create a passive RW RV backed by another RW RV by disabling change
-- propagation.
passivelyRW :: (Monad m, ReactiveValueReadWrite a b m)
            => a -> ReactiveFieldReadWrite m b
passivelyRW :: a -> ReactiveFieldReadWrite m b
passivelyRW a
rv =
  FieldSetter m b
-> FieldGetter m b
-> FieldNotifier m b
-> ReactiveFieldReadWrite m b
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite
    (a -> FieldSetter m b
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite a
rv)
    (a -> FieldGetter m b
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead a
rv)
    (\m ()
_ -> () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())

-- | A form of binary readable lifting that passifies the second RV but reads
-- exclusively from it.
--
-- governingR r1 r2 = rMerge r1 (passively r2)

governingR :: (ReactiveValueRead a b m,  ReactiveValueRead c d m)
           => a -> c -> ReactiveFieldRead m d
governingR :: a -> c -> ReactiveFieldRead m d
governingR a
r c
c = FieldGetter m d -> FieldNotifier m d -> ReactiveFieldRead m d
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m d
getter FieldNotifier m d
notifier
  where
    getter :: FieldGetter m d
getter   = c -> FieldGetter m d
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
    notifier :: FieldNotifier m d
notifier = a -> FieldNotifier m d
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
r

-- | A form of binary read-writable lifting that passifies the second RV but
-- reads exclusively from it.

governingRW :: (ReactiveValueRead a b m,  ReactiveValueReadWrite c d m)
           => a -> c -> ReactiveFieldReadWrite m d
governingRW :: a -> c -> ReactiveFieldReadWrite m d
governingRW a
r c
c = FieldSetter m d
-> FieldGetter m d
-> FieldNotifier m d
-> ReactiveFieldReadWrite m d
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite FieldSetter m d
setter FieldGetter m d
getter FieldNotifier m d
notifier
  where
    getter :: FieldGetter m d
getter   = c -> FieldGetter m d
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
    setter :: FieldSetter m d
setter   = c -> FieldSetter m d
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite c
c
    notifier :: FieldNotifier m d
notifier = a -> FieldNotifier m d
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead a
r

-- | Check condition, and write or notify only when it holds.
ifRW :: (Monad m, ReactiveValueRead c Bool m, ReactiveValueReadWrite v a m)
     => c -> v
     -> ReactiveFieldReadWrite m a
ifRW :: c -> v -> ReactiveFieldReadWrite m a
ifRW c
c v
r = FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite FieldSetter m a
forall (m :: * -> *) b.
(ReactiveValueRead c Bool m, ReactiveValueWrite v b m) =>
b -> m ()
setter FieldGetter m a
getter FieldNotifier m a
forall (m :: * -> *) b.
(ReactiveValueRead c Bool m, ReactiveValueRead v b m) =>
m () -> m ()
notifier
  where
    setter :: b -> m ()
setter b
x   = do Bool
b <- c -> m Bool
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
                    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ v -> b -> m ()
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite v
r b
x
    getter :: FieldGetter m a
getter     = v -> FieldGetter m a
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead v
r
    -- If either changes, the value *may* be propagated
    notifier :: m () -> m ()
notifier m ()
p = do c -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead c
c (m () -> m ()
forall (m :: * -> *). ReactiveValueRead c Bool m => m () -> m ()
when' m ()
p)
                    v -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead v
r (m () -> m ()
forall (m :: * -> *). ReactiveValueRead c Bool m => m () -> m ()
when' m ()
p)
      where
        -- Propagate only if the condition holds
        when' :: m () -> m ()
when' m ()
m = do Bool
b <- c -> m Bool
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
                     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b m ()
m

-- | Check condition and notify only when holds (but writing occurs
-- regardless).
ifRW_ :: (Monad m, ReactiveValueRead c Bool m, ReactiveValueReadWrite v a m)
      => c -> v
      -> ReactiveFieldReadWrite m a
ifRW_ :: c -> v -> ReactiveFieldReadWrite m a
ifRW_ c
c v
r = FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
forall (m :: * -> *) a.
FieldSetter m a
-> FieldGetter m a
-> FieldNotifier m a
-> ReactiveFieldReadWrite m a
ReactiveFieldReadWrite FieldSetter m a
setter FieldGetter m a
getter FieldNotifier m a
forall (m :: * -> *) b.
(ReactiveValueRead c Bool m, ReactiveValueRead v b m) =>
m () -> m ()
notifier
  where
    setter :: FieldSetter m a
setter = v -> FieldSetter m a
forall a b (m :: * -> *).
ReactiveValueWrite a b m =>
a -> b -> m ()
reactiveValueWrite v
r
    getter :: FieldGetter m a
getter = v -> FieldGetter m a
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead v
r
    -- If either changes, the value *may* be propagated
    notifier :: m () -> m ()
notifier m ()
p = do c -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead c
c (m () -> m ()
forall (m :: * -> *). ReactiveValueRead c Bool m => m () -> m ()
when' m ()
p)
                    v -> m () -> m ()
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead v
r (m () -> m ()
forall (m :: * -> *). ReactiveValueRead c Bool m => m () -> m ()
when' m ()
p)
      where
        -- Propagate only if the condition holds
        when' :: m () -> m ()
when' m ()
m = do Bool
x <- c -> m Bool
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
                     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x m ()
m

-- | Check RV carrying a 'Bool', and notify only when it changes and it is
-- 'True'.
guardRO :: (Monad m, ReactiveValueRead c Bool m)
        => c
        -> ReactiveFieldRead m Bool
guardRO :: c -> ReactiveFieldRead m Bool
guardRO c
c = FieldGetter m Bool
-> FieldNotifier m Bool -> ReactiveFieldRead m Bool
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m Bool
getter FieldNotifier m Bool
notifier
  where
    getter :: FieldGetter m Bool
getter   = c -> FieldGetter m Bool
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
    -- If either changes, the value *may* be propagated
    notifier :: FieldNotifier m Bool
notifier = c -> FieldNotifier m Bool
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead c
c FieldNotifier m Bool
-> FieldNotifier m Bool -> FieldNotifier m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNotifier m Bool
forall (m :: * -> *). ReactiveValueRead c Bool m => m () -> m ()
when'
      where
        -- Propagate only if the condition holds
        when' :: m () -> m ()
when' m ()
m = do Bool
x <- c -> m Bool
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
                     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
x m ()
m

-- | Check RV and notify only when condition on the value holds (stops
-- propagation by filtering on the new value).
guardRO' :: (Monad m, ReactiveValueRead c a m)
         => c
         -> (a -> Bool)
         -> ReactiveFieldRead m a
guardRO' :: c -> (a -> Bool) -> ReactiveFieldRead m a
guardRO' c
c a -> Bool
p = FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
forall (m :: * -> *) a.
FieldGetter m a -> FieldNotifier m a -> ReactiveFieldRead m a
ReactiveFieldRead FieldGetter m a
getter FieldNotifier m a
notifier
  where
    getter :: FieldGetter m a
getter   = c -> FieldGetter m a
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
    -- If either changes, the value *may* be propagated
    notifier :: FieldNotifier m a
notifier = c -> FieldNotifier m a
forall a b (m :: * -> *).
ReactiveValueRead a b m =>
a -> m () -> m ()
reactiveValueOnCanRead c
c FieldNotifier m a -> FieldNotifier m a -> FieldNotifier m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldNotifier m a
forall (m :: * -> *). ReactiveValueRead c a m => m () -> m ()
when'

      -- Propagate only if the condition holds
      where
        when' :: m () -> m ()
when' m ()
m = do a
x <- c -> m a
forall a b (m :: * -> *). ReactiveValueRead a b m => a -> m b
reactiveValueRead c
c
                     Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
p a
x) m ()
m

-- Category theoretic definitions

-- Functor definitions
instance (Functor m, Monad m) => Functor (ReactiveFieldRead m) where
  fmap :: (a -> b) -> ReactiveFieldRead m a -> ReactiveFieldRead m b
fmap = (a -> b) -> ReactiveFieldRead m a -> ReactiveFieldRead m b
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueRead a b m) =>
(b -> c) -> a -> ReactiveFieldRead m c
liftR

instance (Monad m) => Contravariant (ReactiveFieldWrite m) where
  contramap :: (a -> b) -> ReactiveFieldWrite m b -> ReactiveFieldWrite m a
contramap = (a -> b) -> ReactiveFieldWrite m b -> ReactiveFieldWrite m a
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueWrite a b m) =>
(c -> b) -> a -> ReactiveFieldWrite m c
liftW

instance Monad m => GFunctor (ReactiveFieldReadWrite m) BijectiveFunc where
  gmap :: BijectiveFunc a b
-> ReactiveFieldReadWrite m a -> ReactiveFieldReadWrite m b
gmap = BijectiveFunc a b
-> ReactiveFieldReadWrite m a -> ReactiveFieldReadWrite m b
forall (m :: * -> *) a b c.
(Monad m, ReactiveValueReadWrite a b m) =>
BijectiveFunc b c -> a -> ReactiveFieldReadWrite m c
liftRW