keera-hails-reactivevalues 0.1.0 → 0.1.2.1

raw patch · 2 files changed

+157/−48 lines, 2 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• keera-hails-reactivevalues.cabal +1/−1
• src/Data/ReactiveValue.hs +156/−47

@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version:             0.1.0+Version:             0.1.2.1  -- A short (one-line) description of the package. Synopsis:            Haskell on Rails - Reactive Values

@@ -1,11 +1,24 @@ {-# LANGUAGE MultiParamTypeClasses, FlexibleInstances, FunctionalDependencies #-} {-# LANGUAGE FlexibleContexts #-}--- | This is a more general, cleaner interface that allows Model to Model--- synchronization and view to view.+-- | Reactive Values are typed mutable variables with a change notification+-- mechanism. ----- It is meant to replace Hails.MVC.Controller.Reactive as soon as--- we do not need to provide an undefined value for the function--- reactiveValueOnCanRead.+-- They are defined by providing a way to read the value, a way to change it,+-- and a way to install an event listener when the value has changed.+--+-- RVs are pruposely defined in an abstract way, as a type class. GUI toolkits,+-- for instance, can use existing event-handling installing mechanisms to+-- enclose widget attributes as Reactive Values, without the need for an+-- extra layer.+--+-- RVs are complemented with Relation-building functions, which+-- enable pairing RVs during execution so that they are kept in+-- sync for the duration of the program.+--+-- This module only defines RVs and operations on them. For connections+-- to existing backends (GUIs, devices, files, network, FRP), see+-- https://github.com/keera-studios/keera-hails+-- module Data.ReactiveValue where  import Control.Monad@@ -13,15 +26,15 @@                         -- in the source category import Data.Functor.Contravariant --- * Reactive values: common interface+-- * Reactive values: common interface for all RVs  -- | Readable reactive values-class ReactiveValueRead a b m | a -> b where+class ReactiveValueRead a b m | a -> b, a -> m where   reactiveValueOnCanRead :: a -> m () -> m ()   reactiveValueRead :: a -> m b  -- | Writable reactive values-class ReactiveValueWrite a b m where+class ReactiveValueWrite a b m | a -> b, a -> m where   reactiveValueWrite :: a -> b -> m ()  -- | Read-write reactive values@@ -34,17 +47,20 @@ infix 9 =:> infix 9 <:= --- | Left to right+-- | 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 () (=:>) v1 v2 = reactiveValueOnCanRead v1 sync1   where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2 --- | Right-to-left+-- | 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 () (<:=) v2 v1 = reactiveValueOnCanRead v1 sync1   where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2 --- | Bidirectional+-- | Bidirectional synchronisation. When either value changes, the other+-- is updated accordingly. (=:=) :: Monad m => (ReactiveValueReadWrite a b m, ReactiveValueReadWrite c b m) => a -> c -> m () (=:=) v1 v2 = do   -- This is often async, so the fact that one comes before the other does not guarantee@@ -56,7 +72,12 @@   -- where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2   --       sync2 = reactiveValueRead v2 >>= reactiveValueWrite v1 --- * Purely functional implementation+-- * Purely functional implementation of RVs.+--+-- 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.  -- ** Setters, getters and notifiers type FieldGetter m a   = m a@@ -110,59 +131,113 @@  where notifier _ = return ()        getter     = return e +-- | TODO: Bad name. Should be eliminated or extended with a setter. initRW :: Monad m => a ->  ReactiveFieldRead m a initRW e = ReactiveFieldRead getter notifier  where notifier _ = return ()        getter     = return e  -- ** Lifting onto readable values-liftR :: (Monad m, ReactiveValueRead a b m) => a -> (b -> c) -> ReactiveFieldRead m c-liftR e f = ReactiveFieldRead getter notifier++-- | 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 f e = ReactiveFieldRead getter notifier  where notifier = reactiveValueOnCanRead e        getter   = liftM f (reactiveValueRead e) +-- | Shorter name for 'liftR'+(<^>) :: (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)-       => a -> c -> (b -> d -> e) -> ReactiveFieldRead m e-liftR2 e1 e2 f = ReactiveFieldRead getter notifier+       => (b -> d -> e) -> a -> c -> ReactiveFieldRead m e+liftR2 f e1 e2 = ReactiveFieldRead getter notifier   where getter = do v1 <- reactiveValueRead e1                     v2 <- reactiveValueRead e2                     return (f v1 v2)         notifier p = do reactiveValueOnCanRead e1 p                         reactiveValueOnCanRead e2 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 f e1 e2 e3 = ReactiveFieldRead getter notifier+  where getter = do v1 <- reactiveValueRead e1+                    v2 <- reactiveValueRead e2+                    v3 <- reactiveValueRead e3+                    return (f v1 v2 v3)+        notifier p = do reactiveValueOnCanRead e1 p+                        reactiveValueOnCanRead e2 p+                        reactiveValueOnCanRead e3 p++-- | Lift a parameterised monadic transformation onto an RV.+-- -- Same as lifting join . f?-liftMR :: (Monad m, ReactiveValueRead a b m) => a -> (b -> m c) -> ReactiveFieldRead m c-liftMR e f = ReactiveFieldRead getter notifier+liftMR :: (Monad m, ReactiveValueRead a b m) => (b -> m c) -> a -> ReactiveFieldRead m c+liftMR f e = ReactiveFieldRead getter notifier  where notifier = reactiveValueOnCanRead e        getter   = f =<< reactiveValueRead e  -- ** Lifting onto writeable values++-- | Create a constant writable RV.+--+constW :: (Monad m, ReactiveValueWrite v a m) => a -> v -> ReactiveFieldWrite m b+constW c v = ReactiveFieldWrite $ \_ -> reactiveValueWrite v 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)-      => a -> (c -> b) -> ReactiveFieldWrite m c-liftW e f = ReactiveFieldWrite setter+      => (c -> b) -> a -> ReactiveFieldWrite m c+liftW f e = ReactiveFieldWrite setter   where setter = reactiveValueWrite e . 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)-       => a -> d -> (c -> (b,e)) -> ReactiveFieldWrite m c-liftW2 e1 e2 f = ReactiveFieldWrite setter+       => (c -> (b,e)) -> a -> d -> ReactiveFieldWrite m c+liftW2 f e1 e2 = ReactiveFieldWrite setter   where setter x = do let (v1,v2) = f x                       reactiveValueWrite e1 v1                       reactiveValueWrite e2 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+(&&&) v1 v2 = ReactiveFieldWrite $ \x -> do+  reactiveValueWrite v1 x+  reactiveValueWrite v2 x+++-- | Lift a parameterised monadic transformation onto an RV. liftMW :: (Monad m, ReactiveValueWrite a b m)-       => a -> (c -> m b) -> ReactiveFieldWrite m c-liftMW e f = ReactiveFieldWrite setter+       => (c -> m b) -> a -> ReactiveFieldWrite m c+liftMW f e = ReactiveFieldWrite setter   where setter x = reactiveValueWrite e =<< f x +-- | Make a RW RV read only readOnly :: ReactiveValueRead r a m => r -> ReactiveFieldRead m a readOnly r = ReactiveFieldRead (reactiveValueRead r) (reactiveValueOnCanRead r) +-- | Make a RW RV write only writeOnly :: ReactiveValueWrite r a m => r -> ReactiveFieldWrite m a writeOnly r = ReactiveFieldWrite (reactiveValueWrite r) --- * Lift monadic operations+-- ** Lift monadic actions/sinks (setters) and sources (getters) --- ** Lifting (sink) computations into writable RVs.+-- *** Lifting (sink) computations into writable RVs.  -- | Wrap a monadic computation in a writable reactive value. wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a@@ -182,7 +257,7 @@ wrapDo_ :: m () -> ReactiveFieldWrite m () wrapDo_ f = wrapMW (\() -> f) --- ** Lifting (source) computations into readable RVs.+-- *** Lifting (source) computations into readable RVs.  -- | Wrap an reading operation and an notification installer in -- a readable reactive value.@@ -195,6 +270,10 @@ wrapMRPassive :: Monad m => m a -> ReactiveFieldRead m a wrapMRPassive f = ReactiveFieldRead f (const (return ())) +-- | Wrap event-handler installers in RVs+eventR :: Monad m => (m () -> m ()) -> ReactiveFieldRead m ()+eventR notifInstaller = ReactiveFieldRead (return ()) notifInstaller+ -- ** Lifting onto read-write values  -- *** Bijections@@ -216,22 +295,22 @@  -- *** Actual lifting liftRW :: (Monad m, ReactiveValueReadWrite a b m)-       => a -> BijectiveFunc b c -> ReactiveFieldReadWrite m c-liftRW e (BijectiveFunc (f1, f2)) = ReactiveFieldReadWrite setter getter notifier-  where ReactiveFieldRead getter notifier = liftR e f1-        ReactiveFieldWrite setter         = liftW e f2+       => BijectiveFunc b c -> a -> ReactiveFieldReadWrite m c+liftRW (BijectiveFunc (f1, f2)) e = ReactiveFieldReadWrite setter getter notifier+  where ReactiveFieldRead getter notifier = liftR f1 e+        ReactiveFieldWrite setter         = liftW f2 e  liftRW2 :: (Monad m, ReactiveValueReadWrite a b m, ReactiveValueReadWrite c d m)-        => a -> c -> BijectiveFunc e (b,d) -> ReactiveFieldReadWrite m e-liftRW2 e1 e2 (BijectiveFunc (f1, f2)) = ReactiveFieldReadWrite setter getter notifier-  where ReactiveFieldRead getter notifier = liftR2 e1 e2 (curry f2)-        ReactiveFieldWrite setter         = liftW2 e1 e2 f1+        => BijectiveFunc e (b,d) -> a -> c -> ReactiveFieldReadWrite m e+liftRW2 (BijectiveFunc (f1, f2)) e1 e2 = ReactiveFieldReadWrite setter getter notifier+  where ReactiveFieldRead getter notifier = liftR2 (curry f2) e1 e2+        ReactiveFieldWrite setter         = liftW2 f1 e1 e2  pairRW :: (Monad m,            ReactiveValueReadWrite a b m,            ReactiveValueReadWrite c d m)        => a -> c -> ReactiveFieldReadWrite m (b, d)-pairRW a b = liftRW2 a b (bijection (id, id))+pairRW a b = liftRW2 (bijection (id, id)) a b  {-# INLINE eqCheck #-} eqCheck :: (Eq v, Monad m) => ReactiveFieldReadWrite m v -> ReactiveFieldReadWrite m v@@ -252,6 +331,18 @@ reactiveValueModify :: (Monad m, ReactiveValueReadWrite a b m) => a -> (b -> b) -> m () reactiveValueModify r f = reactiveValueWrite r . f =<< reactiveValueRead r +-- * Merging++-- | 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 = liftR2 (\a _ -> a)++-- | Right merge (give priority to the value on the left)+rMerge :: (Monad m, ReactiveValueRead a v m, ReactiveValueRead b v m)+       => a -> b -> ReactiveFieldRead m v+rMerge = liftR2 (\_ b -> b)+ -- * Deactivating reactive values  -- | Turning an active RV into a passive one (does not propagate changes)@@ -270,6 +361,17 @@ passivelyRW rv =   ReactiveFieldReadWrite (reactiveValueWrite rv) (reactiveValueRead rv) (\_ -> 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 r c = ReactiveFieldRead getter notifier+  where getter   = reactiveValueRead c+        notifier = reactiveValueOnCanRead r+ -- * Conditionals  -- Check condition and notify only when holds@@ -317,24 +419,31 @@          where when' m = do x <- reactiveValueRead c                             when x m --- * Category theoretic definitions+-- Check condition and notify only when holds+guardRO' :: (Monad m, ReactiveValueRead c a m)+         => c+         -> (a -> Bool)+         -> ReactiveFieldRead m a+guardRO' c p = ReactiveFieldRead getter notifier+  where getter     = reactiveValueRead c+        -- If either changes, the value *may* be propagated+        notifier = reactiveValueOnCanRead c . when' +        -- Propagate only if the condition holds+         where when' m = do x <- reactiveValueRead c+                            when (p x) m++-- Category theoretic definitions+ -- Functor definitions instance (Functor m, Monad m) => Functor (ReactiveFieldRead m) where-  fmap = flip liftR+  fmap = liftR  -- FIXME: I might not want to provide this: the contravariant library -- depends on transformers. -- (ReactiveFieldRead getter notifier) = ReactiveFieldRead (fmap f getter) notifier instance (Monad m) => Contravariant (ReactiveFieldWrite m) where-  contramap = flip liftW+  contramap = liftW  instance Monad m => GFunctor (ReactiveFieldReadWrite m) BijectiveFunc where-  gmap = flip liftRW---- | Temporary: will be moved to Keera Hails' Reactive Values library.-governingR :: (ReactiveValueRead a b m,  ReactiveValueRead c d m)-           => a -> c -> ReactiveFieldRead m d-governingR r c = ReactiveFieldRead getter notifier-  where getter   = reactiveValueRead c-        notifier = reactiveValueOnCanRead r+  gmap = liftRW