keera-hails-reactivevalues 0.7.0 → 0.8.0
raw patch · 4 files changed
+347/−299 lines, 4 filesdep ~basePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: base
API changes (from Hackage documentation)
Files
- keera-hails-reactivevalues.cabal +11/−9
- src/Control/GFunctor.hs +5/−12
- src/Data/ReactiveValue.hs +331/−276
- tests/Tasty.hs +0/−2
keera-hails-reactivevalues.cabal view
@@ -6,7 +6,7 @@ build-type: Simple name: keera-hails-reactivevalues-version: 0.7.0+version: 0.8.0 author: Ivan Perez maintainer: support@keera.co.uk homepage: http://www.keera.co.uk/blog/community/@@ -17,8 +17,8 @@ synopsis: Haskell on Rails - Reactive Values description: This package contains a general definition of Reactive Values and several- useful combinators. A reactive value is a /typed mutable value with access- properties and change propagation/. Access property can be read-only,+ useful combinators. A reactive value is a /typed mutable value with access/+ /properties and change propagation/. Access property can be read-only, read-write or read-write. . How an RV is actually implemented, and when and how change propagation is@@ -66,7 +66,7 @@ Data.ReactiveValue build-depends:- base >= 4 && < 5+ base >= 4 && < 5 , contravariant default-language:@@ -98,8 +98,8 @@ False else build-depends:- base- , hlint >= 1.7+ base >= 4 && < 5+ , hlint >= 1.7 test-suite haddock-coverage@@ -124,7 +124,7 @@ False else build-depends:- base >= 4 && < 5+ base >= 4 && < 5 , directory , filepath , process@@ -156,10 +156,12 @@ else build-depends: base >= 4 && < 5+ , mtl++ , keera-hails-reactivevalues+ , HUnit , QuickCheck- , keera-hails-reactivevalues- , mtl , tasty , tasty-hunit , tasty-quickcheck
src/Control/GFunctor.hs view
@@ -1,18 +1,15 @@-{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-}--- | Functors parameterised over the morphisms in the source category.---+{-# LANGUAGE MultiParamTypeClasses #-}+-- | -- Copyright : (C) Keera Studios Ltd, 2013 -- License : BSD3 -- Maintainer : support@keera.co.uk+--+-- Functors parameterised over the morphisms in the source category. module Control.GFunctor where infixl 8 <$$> --- class ContravariantFunctor f where--- cmap :: (b -> a) -> f a -> f b---- -- | A class for Functors in which the morphisms in the source category do not -- have to be of kind arrow '(->)', but can be anything (see the parameter -- 'm').@@ -22,13 +19,9 @@ -- | Trivial instance for the arrow morphism '(->)'. Anything -- that is a functor is also a GFunctor in the trivial way.-instance (Functor a) => GFunctor a (->) where+instance Functor a => GFunctor a (->) where gmap = fmap -- | A more readable (ignorable) name for 'gmap'. (<$$>) :: GFunctor f m => m a b -> f a -> f b (<$$>) = gmap---- class GFunctor f m => GApplicative f m where--- gpure :: a -> f a--- (<**>) :: f (m a b) -> f a -> f b
src/Data/ReactiveValue.hs view
@@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} -- |--- -- Copyright : (C) Keera Studios Ltd, 2013 -- License : BSD3 -- Maintainer : support@keera.co.uk@@ -48,7 +47,8 @@ -- -- -- Turn IORef into active reactive value (RV). -- ----- -- We use the type of Reactive Fields, which have a trivial RV implementation.+-- -- We use the type of Reactive Fields, which have a trivial RV+-- -- implementation. -- let activeCBRefRV :: ReactiveFieldReadWrite IO Integer -- activeCBRefRV = ReactiveFieldReadWrite -- (writeCBRef passiveCBRef)@@ -59,9 +59,9 @@ -- 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.+-- -- 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@@ -78,131 +78,132 @@ -- <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+ ( -- * Reactive Values+ -- $rvs - -- ** Readable Reactive Values- -- $readablervs- ReactiveValueRead(..)+ -- ** Readable Reactive Values+ -- $readablervs+ ReactiveValueRead(..) - -- ** Writable Reactive Values+ -- ** Writable Reactive Values - -- $writablervs- , ReactiveValueWrite(..)+ -- $writablervs+ , ReactiveValueWrite(..) - -- ** Read-Write Reactive Values+ -- ** Read-Write Reactive Values - -- $readwritervs- , ReactiveValueReadWrite+ -- $readwritervs+ , ReactiveValueReadWrite - -- * Reactive Relations or Rules+ -- * Reactive Relations or Rules - -- $rules- , (=:>)- , (=:=)- , (<:=)+ -- $rules+ , (=:>)+ , (=:=)+ , (<:=) - -- * Reactive Fields (pure RVs)+ -- * Reactive Fields (pure RVs) - -- $fields- , ReactiveFieldRead(..)- , ReactiveFieldWrite(..)- , ReactiveFieldReadWrite(..)+ -- $fields+ , ReactiveFieldRead(..)+ , ReactiveFieldWrite(..)+ , ReactiveFieldReadWrite(..) - -- $settersgetters- , FieldGetter- , FieldSetter- , FieldNotifier+ -- $settersgetters+ , FieldGetter+ , FieldSetter+ , FieldNotifier - -- * RV creation and manipulation+ -- * RV creation and manipulation - -- ** Readable RVs+ -- ** Readable RVs - -- $readablecombinators- , constR- , initRW- , liftR- , (<^>)- , liftR2- , liftR3- , liftMR- , readOnly- , wrapMR- , wrapMRPassive- , eventR- , lMerge- , rMerge+ -- $readablecombinators+ , constR+ , initRW+ , liftR+ , (<^>)+ , liftR2+ , liftR3+ , liftMR+ , readOnly+ , wrapMR+ , wrapMRPassive+ , eventR+ , lMerge+ , rMerge - -- ** Writable RVs+ -- ** Writable RVs - -- $writablecombinators- , constW- , liftW- , liftW2- , (&.&)- , liftMW- , writeOnly- , wrapMW- , wrapDo- , wrapDo_+ -- $writablecombinators+ , constW+ , liftW+ , liftW2+ , (&.&)+ , liftMW+ , writeOnly+ , wrapMW+ , wrapDo+ , wrapDo_ - -- ** Read-write RVs+ -- ** Read-write RVs - -- $readwritecombinators- , liftRW- , liftRW2- , pairRW- , modRW+ -- $readwritecombinators+ , liftRW+ , liftRW2+ , pairRW+ , modRW - -- **** Bijective functions- , BijectiveFunc- , bijection- , direct- , inverse- , Involution- , involution+ -- **** Bijective functions+ , BijectiveFunc+ , bijection+ , direct+ , inverse+ , Involution+ , involution - -- **** Low-level operations- , reactiveValueModify+ -- **** Low-level operations+ , reactiveValueModify - -- * Controlling change+ -- * Controlling change - -- $changecontrol+ -- $changecontrol - -- ** Stopping change propagation- , eqCheck- , passivelyR- , passivelyRW+ -- ** Stopping change propagation+ , eqCheck+ , passivelyR+ , passivelyRW - -- ** Governing- , governingR- , governingRW+ -- ** Governing+ , governingR+ , governingRW - -- ** Guarding- , ifRW- , ifRW_- , guardRO- , guardRO'+ -- ** Guarding+ , ifRW+ , ifRW_+ , guardRO+ , guardRO' - -- * Activatable RVs+ -- * Activatable RVs - -- $activatable- , ReactiveValueActivatable(..)- , ReactiveFieldActivatable- , mkActivatable- )- where+ -- $activatable+ , ReactiveValueActivatable(..)+ , ReactiveFieldActivatable+ , mkActivatable+ )+ where -import Control.Monad-import Control.GFunctor -- Functors parameterised over the morphisms- -- in the source category-import Data.Functor.Contravariant+-- 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@@ -259,8 +260,8 @@ {-# MINIMAL reactiveValueRead #-} --- | Monadic actions are readable, but they do not provide any--- change notification.+-- | 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 = id@@ -271,19 +272,17 @@ -- $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.+-- 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.+-- 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.+-- | 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 () @@ -301,8 +300,10 @@ -- | 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 (_, f) = reactiveValueWrite f+instance ReactiveValueWrite (a -> m b) a m+ => ReactiveValueWrite (m a, a -> m b) a m+ where+ reactiveValueWrite (_, f) = reactiveValueWrite f -- $readwritervs --@@ -311,9 +312,10 @@ -- -- | 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+-- 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@@ -323,15 +325,15 @@ -- 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.+-- | 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+-- 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@@ -345,31 +347,42 @@ -- | 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 ()+(=:>) :: Monad m+ => (ReactiveValueRead a b m, ReactiveValueWrite c b m)+ => a+ -> c+ -> m () (=:>) v1 v2 = reactiveValueOnCanRead v1 sync1- where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2+ where+ sync1 = reactiveValueRead v1 >>= reactiveValueWrite 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 ()+(<:=) :: Monad m+ => (ReactiveValueRead a b m, ReactiveValueWrite c b m)+ => c+ -> a+ -> m () (<:=) v2 v1 = reactiveValueOnCanRead v1 sync1- where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2+ where+ sync1 = reactiveValueRead v1 >>= reactiveValueWrite 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 ()+(=:=) :: 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- -- that they will be refreshed in that order.+ -- This is often async, so the fact that one comes before the other does not+ -- guarantee that they will be refreshed in that order. v1 =:> v2 v1 <:= v2- -- reactiveValueOnCanRead v1 sync1- -- reactiveValueOnCanRead v2 sync2- -- where sync1 = reactiveValueRead v1 >>= reactiveValueWrite v2- -- sync2 = reactiveValueRead v2 >>= reactiveValueWrite v1 -- $fields--- This is a specific implementation of RVs that does not have a custom event queue.+-- 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@@ -409,10 +422,10 @@ -- $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.+-- 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@@ -421,89 +434,108 @@ type FieldSetter m a = a -> m () -- | The type of an event handler installer-type FieldNotifier m a = m () -> m () -- FIXME: why does fieldnotifier have an argument+type FieldNotifier m a = m () -> m () -- | Create an activatable RV from a handler installer. mkActivatable :: Monad m => (m () -> m ()) -> ReactiveFieldActivatable m mkActivatable f = ReactiveFieldRead getter notifier- where getter = return ()- notifier = f+ where+ getter = return ()+ notifier = 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.+-- | 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 e = ReactiveFieldRead getter notifier- where notifier _ = return ()- getter = return e+ where+ notifier _ = return ()+ getter = return e --- | TODO: Bad name. Should be eliminated or extended with a setter.+{-# 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 e = ReactiveFieldRead getter notifier- where notifier _ = return ()- getter = return e+ where+ notifier _ = return ()+ getter = return 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 :: (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)+ 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+(<^>) :: (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.+-- | 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 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+ 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.+-- | 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+ 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) => (b -> m c) -> a -> ReactiveFieldRead m c+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+ where+ notifier = reactiveValueOnCanRead e+ getter = f =<< reactiveValueRead 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.+-- | Wrap an reading operation and an notification installer in a readable+-- reactive value. wrapMR :: m a -> (m () -> m ()) -> ReactiveFieldRead m a wrapMR f p = ReactiveFieldRead f 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).+-- | 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 f = ReactiveFieldRead f (const (return ())) @@ -520,30 +552,35 @@ -- | Create a constant writable RV. ---constW :: (Monad m, ReactiveValueWrite v a m) => a -> v -> ReactiveFieldWrite m b+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).+-- | 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 f e = ReactiveFieldWrite setter- where setter = reactiveValueWrite e . f+ 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).+-- | 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+ => (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+ 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+-- r1 &.& r2 = liftW2 (\x -> (x, x)) r1 r2 -- (&.&) :: (Monad m, ReactiveValueWrite a b m, ReactiveValueWrite c b m) => a -> c -> ReactiveFieldWrite m b@@ -556,7 +593,8 @@ liftMW :: (Monad m, ReactiveValueWrite a b m) => (c -> m b) -> a -> ReactiveFieldWrite m c liftMW f e = ReactiveFieldWrite setter- where setter x = reactiveValueWrite e =<< f x+ where+ setter x = reactiveValueWrite e =<< f x -- | Make a RW RV write only writeOnly :: ReactiveValueWrite r a m => r -> ReactiveFieldWrite m a@@ -568,21 +606,20 @@ wrapMW :: (a -> m ()) -> ReactiveFieldWrite m a wrapMW = ReactiveFieldWrite --- | Wrap a monadic computation in a writable reactive value.--- It discards the written value and executes the operation.+-- | 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: 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.+-- NOTE: this should be unnecessary since the introduction of a default+-- 'ReactiveValueWrite' instance for monadic actions. wrapDo :: m () -> ReactiveFieldWrite m a wrapDo = wrapMW . const --- | Wrap a monadic computation in a writable reactive value of type--- unit. It discards the written value and executes the operation.+-- | 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_ = wrapDo @@ -616,16 +653,20 @@ -- | Lift a bijection onto a read-write RV liftRW :: (Monad m, ReactiveValueReadWrite a b m) => 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+liftRW (BijectiveFunc (f1, f2)) e =+ ReactiveFieldReadWrite setter getter notifier+ where+ ReactiveFieldRead getter notifier = liftR f1 e+ ReactiveFieldWrite setter = liftW f2 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 (f1, f2)) e1 e2 = ReactiveFieldReadWrite setter getter notifier- where ReactiveFieldRead getter notifier = liftR2 (curry f2) e1 e2- ReactiveFieldWrite setter = liftW2 f1 e1 e2+ => 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 -- | Pair two read-write RVs pairRW :: (Monad m,@@ -635,13 +676,18 @@ -> ReactiveFieldReadWrite m (b, d) pairRW = liftRW2 (bijection (id, 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).+-- | 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 setter getter notifier) = ReactiveFieldReadWrite setter' getter notifier- where setter' v = do o <- getter- when (o /= v) $ setter v+eqCheck :: (Eq v, Monad m)+ => ReactiveFieldReadWrite m v+ -> ReactiveFieldReadWrite m v+eqCheck (ReactiveFieldReadWrite setter getter notifier) =+ ReactiveFieldReadWrite setter' getter notifier+ where+ setter' v = do o <- getter+ when (o /= v) $ setter v -- | Lift a function that takes an old value and a new input and creates a new@@ -650,14 +696,18 @@ modRW :: (Monad m, ReactiveValueReadWrite a b m) => (b -> c -> b) -> a -> ReactiveFieldWrite m c modRW f rv = ReactiveFieldWrite setter- where setter c = do b <- reactiveValueRead rv- let b' = f b c- reactiveValueWrite rv b'+ where+ setter c = do b <- reactiveValueRead rv+ let b' = f b c+ reactiveValueWrite rv 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+-- | 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 :: (Monad m, ReactiveValueReadWrite a b m)+ => a+ -> (b -> b)+ -> m () reactiveValueModify r f = reactiveValueWrite r . f =<< reactiveValueRead r {-# ANN lMerge "HLint: ignore Use const" #-}@@ -673,19 +723,18 @@ -- $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.+-- 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.+-- 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.@@ -699,7 +748,10 @@ passivelyRW :: (Monad m, ReactiveValueReadWrite a b m) => a -> ReactiveFieldReadWrite m b passivelyRW rv =- ReactiveFieldReadWrite (reactiveValueWrite rv) (reactiveValueRead rv) (\_ -> return ())+ ReactiveFieldReadWrite+ (reactiveValueWrite rv)+ (reactiveValueRead rv)+ (\_ -> return ()) -- | A form of binary readable lifting that passifies the second RV but reads -- exclusively from it.@@ -709,34 +761,37 @@ 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+ where+ getter = reactiveValueRead c+ notifier = reactiveValueOnCanRead r --- | A form of binary read-writable lifting that passifies the second RV but reads--- exclusively from it.+-- | 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 r c = ReactiveFieldReadWrite setter getter notifier- where getter = reactiveValueRead c- setter = reactiveValueWrite c- notifier = reactiveValueOnCanRead r+ where+ getter = reactiveValueRead c+ setter = reactiveValueWrite c+ notifier = reactiveValueOnCanRead 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 r = ReactiveFieldReadWrite setter getter notifier- where setter x = do b <- reactiveValueRead c- when b $ reactiveValueWrite r x- getter = reactiveValueRead r- -- If either changes, the value *may* be propagated- notifier p = do reactiveValueOnCanRead c (when' p)- reactiveValueOnCanRead r (when' p)-+ where+ setter x = do b <- reactiveValueRead c+ when b $ reactiveValueWrite r x+ getter = reactiveValueRead r+ -- If either changes, the value *may* be propagated+ notifier p = do reactiveValueOnCanRead c (when' p)+ reactiveValueOnCanRead r (when' p)+ where -- Propagate only if the condition holds- where when' m = do b <- reactiveValueRead c- when b m+ when' m = do b <- reactiveValueRead c+ when b m -- | Check condition and notify only when holds (but writing occurs -- regardless).@@ -744,15 +799,16 @@ => c -> v -> ReactiveFieldReadWrite m a ifRW_ c r = ReactiveFieldReadWrite setter getter notifier- where setter = reactiveValueWrite r- getter = reactiveValueRead r- -- If either changes, the value *may* be propagated- notifier p = do reactiveValueOnCanRead c (when' p)- reactiveValueOnCanRead r (when' p)-+ where+ setter = reactiveValueWrite r+ getter = reactiveValueRead r+ -- If either changes, the value *may* be propagated+ notifier p = do reactiveValueOnCanRead c (when' p)+ reactiveValueOnCanRead r (when' p)+ where -- Propagate only if the condition holds- where when' m = do x <- reactiveValueRead c- when x m+ when' m = do x <- reactiveValueRead c+ when x m -- | Check RV carrying a 'Bool', and notify only when it changes and it is -- 'True'.@@ -760,29 +816,31 @@ => c -> ReactiveFieldRead m Bool guardRO c = ReactiveFieldRead getter notifier- where getter = reactiveValueRead c- -- If either changes, the value *may* be propagated- notifier = reactiveValueOnCanRead c . when'-+ where+ getter = reactiveValueRead c+ -- If either changes, the value *may* be propagated+ notifier = reactiveValueOnCanRead c . when'+ where -- Propagate only if the condition holds- where when' m = do x <- reactiveValueRead c- when x m+ when' m = do x <- reactiveValueRead c+ when x m --- | Check RV and notify only when condition on the value holds.------ (stops propagation by filtering on the new value).+-- | 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 p = ReactiveFieldRead getter notifier- where getter = reactiveValueRead c- -- If either changes, the value *may* be propagated- notifier = reactiveValueOnCanRead c . when'+ 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+ -- Propagate only if the condition holds+ where+ when' m = do x <- reactiveValueRead c+ when (p x) m -- Category theoretic definitions @@ -790,9 +848,6 @@ instance (Functor m, Monad m) => Functor (ReactiveFieldRead m) where 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 = liftW
tests/Tasty.hs view
@@ -1,4 +1,3 @@------------------------------------------------------------------------------ -- | -- Module : Main (Tasty) -- Copyright : (C) 2015 Ivan Perez@@ -12,7 +11,6 @@ -- See the following links for instructions and documentation: -- https://github.com/feuerbach/tasty -- https://ocharles.org.uk/blog/posts/2013-12-03-24-days-of-hackage-tasty.html------------------------------------------------------------------------------ -- Testing libraries import Test.Tasty