da669e3 · patch · git.iko.soy

git.iko.soy/patch

Merge remote-tracking branch 'origin/develop' into queryt-optimization

* origin/develop: (52 commits) Rename MonadDynamicWriter Add changelog Add Num instance for Dynamic Bump to version 0.6 Re-export mapMaybe from Filterable Update Collection.hs Remove some more long-deprecated functions Organize exports under correct headings Fix warnings Deprecate FunctorMaybe in favor of Filterable Unorphan MonoidalMap Group and Additive instances Remove some long-deprecated functions Add some docs Add matchResponsesWithRequests Add withRequesterT Bump version in default.nix Bump version to 0.5.0.1 Relax bounds on 'these', add explicit import to avoid clash Update the types of merge and fan Add missing haddock hyperlinks ...

commitda669e3d0cd507fcb52d7ad953e70c2e27642ae2 authorAli Abrar <aliabrar@gmail.com> dateFri 22 Mar 2019, 11:11 (8 years ago) parent512e4ea 767faa1

40 files changed+1011−560

compare with develop

unifiedsplit

ChangeLog.md+10 Quickref.md+6−6 README.md+9−4 default.nix+3−3 reflex.cabal+12−5 src/Data/AppendMap.hs+6−16 src/Data/FastWeakBag.hs+2−2 src/Data/Functor/Misc.hs+1−44 src/Data/Map/Misc.hs+26−10 src/Data/WeakBag.hs+2−2 src/Reflex.hs+1 src/Reflex/Class.hs+231−92 src/Reflex/Collection.hs+150−53 src/Reflex/Dynamic.hs+27−175 src/Reflex/Dynamic/TH.hs+1−25 src/Reflex/DynamicWriter/Base.hs+8−3 src/Reflex/DynamicWriter/Class.hs+9−4 src/Reflex/EventWriter/Base.hs+2−2 src/Reflex/FastWeak.hs+59−5 src/Reflex/FunctorMaybe.hs+23−21 src/Reflex/Network.hs+10−4 src/Reflex/NotReady/Class.hs+10 src/Reflex/Optimizer.hs+8−4 src/Reflex/Patch.hs+12−5 src/Reflex/Patch/Class.hs+1−1 src/Reflex/Patch/DMap.hs+22−8 src/Reflex/Patch/DMapWithMove.hs+3−2 src/Reflex/Patch/IntMap.hs+19−1 src/Reflex/Patch/Map.hs+1−2 src/Reflex/Patch/MapWithMove.hs+59−17 src/Reflex/Profiled.hs+6 src/Reflex/Pure.hs+11−9 src/Reflex/Query/Base.hs+1−1 src/Reflex/Query/Class.hs+1−1 src/Reflex/Requester/Base.hs+112−3 src/Reflex/Spider.hs+5−2 src/Reflex/Spider/Internal.hs+5−5 src/Reflex/Time.hs+113−13 src/Reflex/Workflow.hs+13−1 test/RequesterT.hs+11−9

ChangeLog.mdnew file+10

@@ -0,0 +1,10 @@

1+# Revision history for reflex

3+## 0.6.0.0 -- 2019-03-20

5+* Deprecate FunctorMaybe in favor of Data.Witherable.Filterable. We still export fmapMaybe, ffilter, etc., but they all rely on Filterable now.

6+* Rename MonadDynamicWriter to DynamicWriter and add a deprecation for the old name.

7+* Remove many deprecated functions

8+* Add a Num instance for Dynamic

9+* Add matchRequestsWithResponses to make it easier to use Requester with protocols that don't do this matching for you

10+* Add withRequesterT to map functions over the request and response of a RequesterT

Quickref.md+6−6

@@ -57,15 +57,15 @@ Since MonadHold depends on MonadSample, any [S] function also runs in [H] contex

5757[ ] mergeWith :: (a -> a -> a) -> [Event a] -> Event a

5858[ ] leftmost :: [Event a] -> Event a

5959[ ] mergeList :: [Event a] -> Event (NonEmpty a)

60−[ ] merge :: GCompare k => DMap (WrapArg Event k) -> Event (DMap k)

60+[ ] merge :: GCompare k => DMap k Event -> Event (DMap k Identity)

6161[ ] mergeMap :: Ord k => Map k (Event a) -> Event (Map k a)

6262

6363-- Efficient one-to-many fanout

64−[ ] fanMap :: Ord k => Event (Map k a) -> EventSelector (Const2 k a)

65−[ ] fan :: GCompare k => Event (DMap k) -> EventSelector k

66−[ ] select :: EventSelector k -> k a -> Event a

67−[ ] fanEither :: Event (Either a b) -> (Event a, Event b)

68−[ ] fanThese :: Event (These a b) -> (Event a, Event b)

64+[ ] fanMap :: Ord k => Event (Map k a) -> EventSelector (Const2 k a)

65+[ ] fan :: GCompare k => Event (DMap k Identity) -> EventSelector k

66+[ ] select :: EventSelector k -> k a -> Event a

67+[ ] fanEither :: Event (Either a b) -> (Event a, Event b)

68+[ ] fanThese :: Event (These a b) -> (Event a, Event b)

6969

7070-- Event to Event via function that can sample current values

7171[ ] push :: (a -> m (Maybe b)) -> Event a -> Event b

README.md+9−4

@@ -1,15 +1,15 @@

1−## Reflex

1+## [Reflex](https://reflex-frp.org/)

22### Practical Functional Reactive Programming

44Reflex is an fully-deterministic, higher-order Functional Reactive Programming (FRP) interface and an engine that efficiently implements that interface.

66[Reflex-DOM](https://github.com/reflex-frp/reflex-dom) is a framework built on Reflex that facilitates the development of web pages, including highly-interactive single-page apps.

8−Comprehensive documentation is still a work in progress, but a tutorial for Reflex and Reflex-DOM is available at https://github.com/reflex-frp/reflex-platform and an introductory talk given at the New York Haskell Meetup is available here: [Part 1](https://www.youtube.com/watch?v=mYvkcskJbc4) / [Part 2](https://www.youtube.com/watch?v=3qfc9XFVo2c).

9−

108A summary of Reflex functions is available in the [quick reference](Quickref.md).

119

12−### Additional resources

10+**Visit https://reflex-frp.org/ for more information, tutorials, documentation and [examples](https://examples.reflex-frp.org/).**

11+

12+### Resources

1313[Get started with Reflex](https://github.com/reflex-frp/reflex-platform)

1414

1515[/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

@@ -17,3 +17,8 @@ A summary of Reflex functions is available in the [quick reference](Quickref.md)

1717[hackage](https://hackage.haskell.org/package/reflex)

1818

1919[irc.freenode.net #reflex-frp](http://webchat.freenode.net?channels=%23reflex-frp&uio=d4)

20+

21+### Hacking

22+

23+Use the `./scripts/hackon reflex` script in [Reflex Platform](https://github.com/reflex-frp/reflex-platform) to checkout the source code of `reflex` locally in `reflex-platform/reflex` directory.

24+Then do modifications to the source in place, and use the `./tryreflex` or `./scripts/workon` scripts to create the shell to test your changes.

default.nix+3−3

@@ -6,12 +6,12 @@

66, template-haskell , these, time, transformers

77, transformers-compat, unbounded-delays, prim-uniq

88, data-default, filepath, directory, filemanip, ghcjs-base

9−, monoidal-containers

9+, monoidal-containers, witherable

1010, useTemplateHaskell ? true

1111}:

1212mkDerivation {

1313 pname = "reflex";

14− version = "0.5";

14+ version = "0.5.0.1";

1515 src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;

1616 libraryHaskellDepends = [

1717 base bifunctors containers dependent-map dependent-sum

@@ -21,7 +21,7 @@ mkDerivation {

2121 transformers-compat prim-uniq

2222 base bifunctors containers deepseq dependent-map dependent-sum

2323 mtl ref-tf split transformers data-default

24− random time unbounded-delays monoidal-containers

24+ random time unbounded-delays monoidal-containers witherable

2525 ] ++ (if ghc.isGhcjs or false then [

2626 ghcjs-base

2727 ] else []) ++ (if !useTemplateHaskell then [] else [

reflex.cabal+12−5

@@ -1,5 +1,5 @@

11Name: reflex

2−Version: 0.5

2+Version: 0.6

33Synopsis: Higher-order Functional Reactive Programming

44Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system

55License: BSD3

@@ -12,6 +12,10 @@ Build-type: Simple

1212Cabal-version: >=1.9.2

1313homepage: https://reflex-frp.org

1414bug-reports: https://github.com/reflex-frp/reflex/issues

15+extra-source-files:

16+ README.md

17+ Quickref.md

18+ ChangeLog.md

1519

1620flag use-reflex-optimizer

1721 description: Use the GHC plugin Reflex.Optimizer on some of the modules in the package. This is still experimental.

@@ -37,7 +41,7 @@ library

3741 hs-source-dirs: src

3842 build-depends:

3943 MemoTrie == 0.6.*,

40− base >= 4.7 && < 4.13,

44+ base >= 4.9 && < 4.13,

4145 bifunctors >= 5.2 && < 5.6,

4246 comonad,

4347 containers >= 0.5 && < 0.7,

@@ -57,11 +61,12 @@ library

5761 semigroups >= 0.16 && < 0.19,

5862 stm >= 2.4 && < 2.6,

5963 syb >= 0.5 && < 0.8,

60− these >= 0.4 && < 0.8,

64+ these >= 0.4 && < 0.7.7,

6165 time >= 1.4 && < 1.9,

6266 transformers >= 0.2,

6367 transformers-compat >= 0.3,

64− unbounded-delays >= 0.1.0.0 && < 0.2

68+ unbounded-delays >= 0.1.0.0 && < 0.2,

69+ witherable >= 0.2 && < 0.4

6570

6671 exposed-modules:

6772 Data.AppendMap,

@@ -230,14 +235,16 @@ test-suite RequesterT

230235 main-is: RequesterT.hs

231236 hs-source-dirs: test

232237 build-depends: base

238+ , containers

239+ , deepseq >= 1.3 && < 1.5

233240 , dependent-sum

234241 , dependent-map

235242 , lens

243+ , mtl

236244 , these

237245 , transformers

238246 , reflex

239247 , ref-tf

240− buildable: False

241248 other-modules:

242249 Reflex.TestPlan

243250 Reflex.Plan.Pure

src/Data/AppendMap.hs+6−16

@@ -1,15 +1,10 @@

11{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveFunctor #-}

3−{-# LANGUAGE DeriveGeneric #-}

4−{-# LANGUAGE DeriveTraversable #-}

52{-# LANGUAGE FlexibleContexts #-}

63{-# LANGUAGE FlexibleInstances #-}

7−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

84{-# LANGUAGE MultiParamTypeClasses #-}

95{-# LANGUAGE PatternSynonyms #-}

106{-# LANGUAGE RoleAnnotations #-}

117{-# LANGUAGE ScopedTypeVariables #-}

12−{-# LANGUAGE StandaloneDeriving #-}

138{-# LANGUAGE TypeFamilies #-}

149{-# OPTIONS_GHC -fno-warn-orphans #-}

1510-- | 'Data.Map' with a better 'Monoid' instance

@@ -31,9 +26,9 @@ import qualified Data.Map.Internal.Debug as Map (showTree, showTreeWith)

3126#else

3227import qualified Data.Map as Map (showTree, showTreeWith)

3328#endif

34−import Data.Map.Monoidal

35−import Reflex.Class (FunctorMaybe (..))

36−import Reflex.Patch (Additive, Group (..))

29+import Data.Witherable (Filterable(..))

30+import Data.Map.Monoidal (MonoidalMap(..), delete, null, empty)

31+import qualified Data.Map.Monoidal as M

3732

3833{-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-}

3934type AppendMap = MonoidalMap

@@ -45,8 +40,8 @@ _unAppendMap = getMonoidalMap

4540pattern AppendMap :: Map k v -> MonoidalMap k v

4641pattern AppendMap m = MonoidalMap m

4742

48−instance FunctorMaybe (MonoidalMap k) where

49− fmapMaybe = mapMaybe

43+instance Filterable (MonoidalMap k) where

44+ mapMaybe = M.mapMaybe

5045

5146-- | Deletes a key, returning 'Nothing' if the result is empty.

5247nonEmptyDelete :: Ord k => k -> MonoidalMap k a -> Maybe (MonoidalMap k a)

@@ -60,17 +55,12 @@ mapMaybeNoNull :: (a -> Maybe b)

6055 -> MonoidalMap token a

6156 -> Maybe (MonoidalMap token b)

6257mapMaybeNoNull f as =

63− let bs = fmapMaybe f as

58+ let bs = mapMaybe f as

6459 in if null bs

6560 then Nothing

6661 else Just bs

6762

6863-- TODO: Move instances to `Reflex.Patch`

69−instance (Ord k, Group q) => Group (MonoidalMap k q) where

70− negateG = map negateG

71−

72−instance (Ord k, Additive q) => Additive (MonoidalMap k q)

73−

7464showTree :: forall k a. (Show k, Show a) => MonoidalMap k a -> String

7565showTree = coerce (Map.showTree :: Map k a -> String)

7666

src/Data/FastWeakBag.hs+2−2

@@ -42,8 +42,8 @@ import Data.IORef

4242import System.Mem.Weak

4343#endif

4444

45−-- | A @FastWeakBag a@ holds a set of values of type @a@, but does not retain them -

46−-- that is, they can still be garbage-collected. As long as the @a@s remain

45+-- | A 'FastWeakBag' holds a set of values of type @/a/@, but does not retain them -

46+-- that is, they can still be garbage-collected. As long as the @/a/@ values remain

4747-- alive, the 'FastWeakBag' will continue to refer to them.

4848#ifdef GHCJS_FAST_WEAK

4949newtype FastWeakBag a = FastWeakBag JSVal

src/Data/Functor/Misc.hs+1−44

@@ -38,17 +38,10 @@ module Data.Functor.Misc

3838 , dmapToThese

3939 , eitherToDSum

4040 , dsumToEither

41− -- * Deprecated functions

42− , sequenceDmap

43− , wrapDMap

44− , rewrapDMap

45− , unwrapDMap

46− , unwrapDMapMaybe

47− , extractFunctorDMap

4841 , ComposeMaybe (..)

4942 ) where

5043

51−import Control.Applicative (Applicative, (<$>))

44+import Control.Applicative ((<$>))

5245import Control.Monad.Identity

5346import Data.Dependent.Map (DMap)

5447import qualified Data.Dependent.Map as DMap

@@ -249,39 +242,3 @@ newtype ComposeMaybe f a =

249242 ComposeMaybe { getComposeMaybe :: Maybe (f a) } deriving (Show, Eq, Ord)

250243

251244deriving instance Functor f => Functor (ComposeMaybe f)

252−

253−--------------------------------------------------------------------------------

254−-- Deprecated functions

255−--------------------------------------------------------------------------------

256−

257−{-# INLINE sequenceDmap #-}

258−{-# DEPRECATED sequenceDmap "Use 'Data.Dependent.Map.traverseWithKey (\\_ -> fmap Identity)' instead" #-}

259−-- | Run the actions contained in the 'DMap'

260−sequenceDmap :: Applicative t => DMap f t -> t (DMap f Identity)

261−sequenceDmap = DMap.traverseWithKey $ \_ t -> Identity <$> t

262−

263−{-# DEPRECATED wrapDMap "Use 'Data.Dependent.Map.map (f . runIdentity)' instead" #-}

264−-- | Replace the 'Identity' functor for a 'DMap''s values with a different functor

265−wrapDMap :: (forall a. a -> f a) -> DMap k Identity -> DMap k f

266−wrapDMap f = DMap.map $ f . runIdentity

267−

268−{-# DEPRECATED rewrapDMap "Use 'Data.Dependent.Map.map' instead" #-}

269−-- | Replace one functor for a 'DMap''s values with a different functor

270−rewrapDMap :: (forall (a :: *). f a -> g a) -> DMap k f -> DMap k g

271−rewrapDMap = DMap.map

272−

273−{-# DEPRECATED unwrapDMap "Use 'Data.Dependent.Map.map (Identity . f)' instead" #-}

274−-- | Replace one functor for a 'DMap''s values with the 'Identity' functor

275−unwrapDMap :: (forall a. f a -> a) -> DMap k f -> DMap k Identity

276−unwrapDMap f = DMap.map $ Identity . f

277−

278−{-# DEPRECATED unwrapDMapMaybe "Use 'Data.Dependent.Map.mapMaybeWithKey (\\_ a -> fmap Identity $ f a)' instead" #-}

279−-- | Like 'unwrapDMap', but possibly delete some values from the DMap

280−unwrapDMapMaybe :: GCompare k => (forall a. f a -> Maybe a) -> DMap k f -> DMap k Identity

281−unwrapDMapMaybe f = DMap.mapMaybeWithKey $ \_ a -> Identity <$> f a

282−

283−{-# DEPRECATED extractFunctorDMap "Use 'mapKeyValuePairsMonotonic (\\(Const2 k :=> Identity v) -> Const2 k :=> v)' instead" #-}

284−-- | Eliminate the 'Identity' functor in a 'DMap' and replace it with the

285−-- underlying functor

286−extractFunctorDMap :: DMap (Const2 k (f v)) Identity -> DMap (Const2 k v) f

287−extractFunctorDMap = mapKeyValuePairsMonotonic $ \(Const2 k :=> Identity v) -> Const2 k :=> v

src/Data/Map/Misc.hs+26−10

@@ -1,4 +1,5 @@

11{-# LANGUAGE LambdaCase #-}

2+-- | Additional functions for manipulating 'Map's.

23module Data.Map.Misc

34 (

45 -- * Working with Maps

@@ -10,7 +11,6 @@ module Data.Map.Misc

1011 ) where

1112

1213import Data.Align

13−import Data.Either (isLeft)

1414import Data.Map (Map)

1515import qualified Data.Map as Map

1616import Data.Maybe

@@ -18,12 +18,21 @@ import Data.Set (Set)

1818import qualified Data.Set as Set

1919import Data.These

2020

21+-- |Produce a @'Map' k (Maybe v)@ by comparing two @'Map' k v@s, @old@ and @new@ respectively. @Just@ represents an association present in @new@ and @Nothing@

22+-- represents an association only present in @old@ but no longer present in @new@.

23+--

24+-- Similar to 'diffMap' but doesn't require 'Eq' on the values, thus can't tell if a value has changed or not.

2125diffMapNoEq :: (Ord k) => Map k v -> Map k v -> Map k (Maybe v)

2226diffMapNoEq olds news = flip Map.mapMaybe (align olds news) $ \case

2327 This _ -> Just Nothing

2428 These _ new -> Just $ Just new

2529 That new -> Just $ Just new

2630

31+-- |Produce a @'Map' k (Maybe v)@ by comparing two @'Map' k v@s, @old@ and @new respectively. @Just@ represents an association present in @new@ and either not

32+-- present in @old@ or where the value has changed. @Nothing@ represents an association only present in @old@ but no longer present in @new@.

33+--

34+-- See also 'diffMapNoEq' for a similar but weaker version which does not require 'Eq' on the values but thus can't indicated a value not changing between

35+-- @old@ and @new@ with @Nothing@.

2736diffMap :: (Ord k, Eq v) => Map k v -> Map k v -> Map k (Maybe v)

2837diffMap olds news = flip Map.mapMaybe (align olds news) $ \case

2938 This _ -> Just Nothing

@@ -32,23 +41,30 @@ diffMap olds news = flip Map.mapMaybe (align olds news) $ \case

3241 | otherwise -> Just $ Just new

3342 That new -> Just $ Just new

3443

44+-- |Given a @'Map' k (Maybe v)@ representing keys to insert/update (@Just@) or delete (@Nothing@), produce a new map from the given input @'Map' k v@.

45+--

46+-- See also 'Reflex.Patch.Map' and 'Reflex.Patch.MapWithMove'.

3547applyMap :: Ord k => Map k (Maybe v) -> Map k v -> Map k v

3648applyMap patch old = insertions `Map.union` (old `Map.difference` deletions)

37− where (deletions, insertions) = mapPartitionEithers $ maybeToEither <$> patch

49+ where (deletions, insertions) = Map.mapEither maybeToEither patch

3850 maybeToEither = \case

3951 Nothing -> Left ()

4052 Just r -> Right r

4153

54+-- |Split a @'Map' k (Either a b)@ into @Map k a@ and @Map k b@, equivalent to @'Map.mapEither' id@

55+{-# DEPRECATED mapPartitionEithers "Use 'mapEither' instead" #-}

4256mapPartitionEithers :: Map k (Either a b) -> (Map k a, Map k b)

43−mapPartitionEithers m = (fromLeft <$> ls, fromRight <$> rs)

44− where (ls, rs) = Map.partition isLeft m

45− fromLeft (Left l) = l

46− fromLeft _ = error "mapPartitionEithers: fromLeft received a Right value; this should be impossible"

47− fromRight (Right r) = r

48− fromRight _ = error "mapPartitionEithers: fromRight received a Left value; this should be impossible"

57+mapPartitionEithers = Map.mapEither id

4958

50−-- | Apply a map patch to a set

51−-- > applyMapKeysSet patch (Map.keysSet m) == Map.keysSet (applyMap patch m)

59+-- |Given a @'Map' k (Maybe v)@ representing keys to insert/update (@Just@) or delete (@Nothing@), produce a new @'Set' k@ from the given input set.

60+--

61+-- Equivalent to:

62+--

63+-- @

64+-- applyMapKeysSet patch ('Map.keysSet' m) == 'Map.keysSet' ('applyMap' patch m)

65+-- @

66+--

67+-- but avoids the intervening @Map@ and needs no values.

5268applyMapKeysSet :: Ord k => Map k (Maybe v) -> Set k -> Set k

5369applyMapKeysSet patch old = Map.keysSet insertions `Set.union` (old `Set.difference` Map.keysSet deletions)

5470 where (insertions, deletions) = Map.partition isJust patch

src/Data/WeakBag.hs+2−2

@@ -31,8 +31,8 @@ import qualified Data.IntMap.Strict as IntMap

3131import Data.IORef

3232import System.Mem.Weak

3333

34−-- | A @WeakBag a@ holds a set of values of type @a@, but does not retain them -

35−-- that is, they can still be garbage-collected. As long as the @a@s remain

34+-- | A 'WeakBag' holds a set of values of type @/a/@, but does not retain them -

35+-- that is, they can still be garbage-collected. As long as the @/a/@ values remain

3636-- alive, the 'WeakBag' will continue to refer to them.

3737data WeakBag a = WeakBag

3838 { _weakBag_nextId :: {-# UNPACK #-} !(IORef Int) --TODO: what if this wraps around?

src/Reflex.hs+1

@@ -19,6 +19,7 @@ import Reflex.Dynamic.TH as X

1919import Reflex.Dynamic.Uniq as X

2020import Reflex.DynamicWriter.Base as X

2121import Reflex.DynamicWriter.Class as X

22+import Reflex.NotReady.Class as X

2223import Reflex.PerformEvent.Base as X

2324import Reflex.PerformEvent.Class as X

2425import Reflex.PostBuild.Base as X

src/Reflex/Class.hs+231−92

@@ -21,9 +21,13 @@

2121{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

2222#endif

2323

24−-- | This module contains the Reflex interface, as well as a variety of

25−-- convenience functions for working with 'Event's, 'Behavior's, and other

26−-- signals.

24+-- |

25+-- Module:

26+-- Reflex.Class

27+-- Description:

28+-- This module contains the Reflex interface, as well as a variety of

29+-- convenience functions for working with 'Event's, 'Behavior's, and other

30+-- signals.

2731module Reflex.Class

2832 ( module Reflex.Patch

2933 -- * Primitives

@@ -34,10 +38,9 @@ module Reflex.Class

3438 , coerceDynamic

3539 , MonadSample (..)

3640 , MonadHold (..)

37− -- ** 'fan'-related types

41+ -- ** 'fan' related types

3842 , EventSelector (..)

3943 , EventSelectorInt (..)

40− -- ** 'Incremental'-related types

4144 -- * Convenience functions

4245 , constDyn

4346 , pushAlways

@@ -134,8 +137,10 @@ module Reflex.Class

134137 -- * Unsafe functions

135138 , unsafeDynamic

136139 , unsafeMapIncremental

137− -- * 'FunctorMaybe'

138− , FunctorMaybe (..)

140+ -- * 'Filterable' convenience functions

141+ , FunctorMaybe -- fmapMaybe is purposely not exported from deprecated 'FunctorMaybe' and the new alias is exported instead

142+ , mapMaybe -- Re-exported for convenience

143+ , fmapMaybe

139144 , fforMaybe

140145 , ffilter

141146 , filterLeft

@@ -145,10 +150,11 @@ module Reflex.Class

145150 , ffor2

146151 , ffor3

147152 -- * Deprecated functions

148− , appendEvents

149− , onceE

150− , sequenceThese

153+ , switchPromptly

154+ , switchPromptOnly

155+ -- * "Cheap" functions

151156 , fmapMaybeCheap

157+ , mapMaybeCheap

152158 , fmapCheap

153159 , fforCheap

154160 , fforMaybeCheap

@@ -156,8 +162,6 @@ module Reflex.Class

156162 , tagCheap

157163 , mergeWithCheap

158164 , mergeWithCheap'

159− , switchPromptly

160− , switchPromptOnly

161165 -- * Slow, but general, implementations

162166 , slowHeadE

163167 ) where

@@ -194,14 +198,17 @@ import qualified Data.Some as Some

194198import Data.String

195199import Data.These

196200import Data.Type.Coercion

197−import Reflex.FunctorMaybe

201+import Data.Witherable (Filterable(..))

202+import qualified Data.Witherable as W

203+import Reflex.FunctorMaybe (FunctorMaybe)

204+import qualified Reflex.FunctorMaybe

198205import Reflex.Patch

199206import qualified Reflex.Patch.MapWithMove as PatchMapWithMove

200207

201208import Debug.Trace (trace)

202209

203210-- | The 'Reflex' class contains all the primitive functionality needed for

204−-- Functional Reactive Programming (FRP). The @t@ type parameter indicates

211+-- Functional Reactive Programming (FRP). The @/t/@ type parameter indicates

205212-- which "timeline" is in use. Timelines are fully-independent FRP contexts,

206213-- and the type of the timeline determines the FRP engine to be used. For most

207214-- purposes, the 'Reflex.Spider' implementation is recommended.

@@ -257,8 +264,7 @@ class ( MonadHold t (PushM t)

257264 -- | Create an 'Event' that will occur whenever the currently-selected input

258265 -- 'Event' occurs

259266 switch :: Behavior t (Event t a) -> Event t a

260− -- | Create an 'Event' that will occur whenever the input event is occurring

261− -- and its occurrence value, another 'Event', is also occurring

267+ -- | Create an 'Event' that will occur whenever the input event is occurring -- and its occurrence value, another 'Event', is also occurring

262268 coincidence :: Event t (Event t a) -> Event t a

263269 -- | Extract the 'Behavior' of a 'Dynamic'.

264270 current :: Dynamic t a -> Behavior t a

@@ -267,7 +273,7 @@ class ( MonadHold t (PushM t)

267273 -- | Create a new 'Dynamic'. The given 'PullM' must always return the most

268274 -- recent firing of the given 'Event', if any.

269275 unsafeBuildDynamic :: PullM t a -> Event t a -> Dynamic t a

270− -- | Create a new 'Incremental'. The given 'PullM''s value must always change

276+ -- | Create a new 'Incremental'. The given "PullM"'s value must always change

271277 -- in the same way that the accumulated application of patches would change

272278 -- that value.

273279 unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p

@@ -310,7 +316,7 @@ coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b

310316coerceDynamic = coerceWith $ dynamicCoercion Coercion

311317

312318-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'

313−-- _must_ change when and only when the 'Event' fires, such that the

319+-- __must__ change when and only when the 'Event' fires, such that the

314320-- 'Behavior''s value is always equal to the most recent firing of the 'Event';

315321-- if this is not the case, the resulting 'Dynamic' will behave

316322-- nondeterministically.

@@ -338,7 +344,7 @@ class MonadSample t m => MonadHold t m where

338344 -- value and will be updated whenever the given 'Event' occurs. The update

339345 -- takes effect immediately after the 'Event' occurs; if the occurrence that

340346 -- sets the 'Behavior' (or one that is simultaneous with it) is used to sample

341− -- the 'Behavior', it will see the _old_ value of the 'Behavior', not the new

347+ -- the 'Behavior', it will see the __old__ value of the 'Behavior', not the new

342348 -- one.

343349 hold :: a -> Event t a -> m (Behavior t a)

344350 default hold :: (m ~ f m', MonadTrans f, MonadHold t m') => a -> Event t a -> m (Behavior t a)

@@ -389,8 +395,8 @@ mapAccumMaybeMIncremental f z e = do

389395 return $ case result of

390396 (Nothing, Nothing) -> Nothing

391397 _ -> Just result

392− d' <- holdIncremental z $ fmapMaybe fst e'

393− return (d', fmapMaybe snd e')

398+ d' <- holdIncremental z $ mapMaybe fst e'

399+ return (d', mapMaybe snd e')

394400

395401slowHeadE :: (Reflex t, MonadHold t m, MonadFix m) => Event t a -> m (Event t a)

396402slowHeadE e = do

@@ -400,14 +406,14 @@ slowHeadE e = do

400406

401407-- | An 'EventSelector' allows you to efficiently 'select' an 'Event' based on a

402408-- key. This is much more efficient than filtering for each key with

403−-- 'fmapMaybe'.

409+-- 'mapMaybe'.

404410newtype EventSelector t k = EventSelector

405411 { -- | Retrieve the 'Event' for the given key. The type of the 'Event' is

406412 -- determined by the type of the key, so this can be used to fan-out

407413 -- 'Event's whose sub-'Event's have different types.

408414 --

409415 -- Using 'EventSelector's and the 'fan' primitive is far more efficient than

410− -- (but equivalent to) using 'fmapMaybe' to select only the relevant

416+ -- (but equivalent to) using 'mapMaybe' to select only the relevant

411417 -- occurrences of an 'Event'.

412418 select :: forall a. k a -> Event t a

413419 }

@@ -542,6 +548,15 @@ instance (Reflex t, Num a) => Num (Behavior t a) where

542548 negate = fmap negate

543549 signum = fmap signum

544550

551+instance (Num a, Reflex t) => Num (Dynamic t a) where

552+ (+) = liftA2 (+)

553+ (*) = liftA2 (*)

554+ abs = fmap abs

555+ signum = fmap signum

556+ fromInteger = pure . fromInteger

557+ negate = fmap negate

558+ (-) = liftA2 (-)

559+

545560instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where

546561 a <> b = pull $ liftM2 (<>) (sample a) (sample b)

547562 sconcat = pull . fmap sconcat . mapM sample

@@ -551,22 +566,25 @@ instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where

551566 times1p n = fmap $ times1p n

552567#endif

553568

554−-- | Flipped version of 'fmapMaybe'.

555−fforMaybe :: FunctorMaybe f => f a -> (a -> Maybe b) -> f b

556−fforMaybe = flip fmapMaybe

569+-- | Alias for 'mapMaybe'

570+fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b

571+fmapMaybe = mapMaybe

572+

573+-- | Flipped version of 'mapMaybe'.

574+fforMaybe :: Filterable f => f a -> (a -> Maybe b) -> f b

575+fforMaybe = flip mapMaybe

557576

558577-- | Filter 'f a' using the provided predicate.

559−-- Relies on 'fforMaybe'.

560−ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a

561−ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing

578+ffilter :: Filterable f => (a -> Bool) -> f a -> f a

579+ffilter = W.filter

562580

563581-- | Filter 'Left's from 'f (Either a b)' into 'a'.

564−filterLeft :: FunctorMaybe f => f (Either a b) -> f a

565−filterLeft = fmapMaybe (either Just (const Nothing))

582+filterLeft :: Filterable f => f (Either a b) -> f a

583+filterLeft = mapMaybe (either Just (const Nothing))

566584

567585-- | Filter 'Right's from 'f (Either a b)' into 'b'.

568−filterRight :: FunctorMaybe f => f (Either a b) -> f b

569−filterRight = fmapMaybe (either (const Nothing) Just)

586+filterRight :: Filterable f => f (Either a b) -> f b

587+filterRight = mapMaybe (either (const Nothing) Just)

570588

571589-- | Left-biased event union (prefers left event on simultaneous

572590-- occurrence).

@@ -584,13 +602,18 @@ instance Reflex t => Bind (Event t) where

584602

585603instance Reflex t => Functor (Event t) where

586604 {-# INLINE fmap #-}

587− fmap f = fmapMaybe $ Just . f

605+ fmap f = mapMaybe $ Just . f

588606 {-# INLINE (<$) #-}

589607 x <$ e = fmapCheap (const x) e

590608

609+-- TODO Remove this instance

591610instance Reflex t => FunctorMaybe (Event t) where

592611 {-# INLINE fmapMaybe #-}

593− fmapMaybe f = push $ return . f

612+ fmapMaybe = mapMaybe

613+

614+instance Reflex t => Filterable (Event t) where

615+ {-# INLINE mapMaybe #-}

616+ mapMaybe f = push $ return . f

594617

595618-- | Never: @'zero' = 'never'@.

596619instance Reflex t => Plus (Event t) where

@@ -641,7 +664,7 @@ headTailE e = do

641664-- event returns 'True'.

642665--

643666-- Starting at the current time, fire all the occurrences of the 'Event' for

644−-- which the given predicate returns 'True'. When 'False' first is returned,

667+-- which the given predicate returns 'True'. When first 'False' is returned,

645668-- do not fire, and permanently stop firing, even if 'True' values would have

646669-- been encountered later.

647670takeWhileE

@@ -656,7 +679,7 @@ takeWhileE f = takeWhileJustE $ \v -> guard (f v) $> v

656679-- event returns 'Just b'.

657680--

658681-- Starting at the current time, fire all the occurrences of the 'Event' for

659−-- which the given predicate returns 'Just b'. When 'Nothing' first is returned,

682+-- which the given predicate returns 'Just b'. When first 'Nothing' is returned,

660683-- do not fire, and permanently stop firing, even if 'Just b' values would have

661684-- been encountered later.

662685takeWhileJustE

@@ -808,7 +831,7 @@ fanEither :: Reflex t => Event t (Either a b) -> (Event t a, Event t b)

808831fanEither e =

809832 let justLeft = either Just (const Nothing)

810833 justRight = either (const Nothing) Just

811− in (fmapMaybe justLeft e, fmapMaybe justRight e)

834+ in (mapMaybe justLeft e, mapMaybe justRight e)

812835

813836-- | Split the event into separate events for 'This' and 'That' values,

814837-- allowing them to fire simultaneously when the input value is 'These'.

@@ -820,7 +843,7 @@ fanThese e =

820843 that (That y) = Just y

821844 that (These _ y) = Just y

822845 that _ = Nothing

823− in (fmapMaybe this e, fmapMaybe that e)

846+ in (mapMaybe this e, mapMaybe that e)

824847

825848-- | Split the event into an 'EventSelector' that allows efficient selection of

826849-- the individual 'Event's.

@@ -829,7 +852,7 @@ fanMap = fan . fmap mapToDMap

829852

830853-- | Switches to the new event whenever it receives one. Only the old event is

831854-- considered the moment a new one is switched in; the output event will fire at

832−-- that moment if only if the old event does.

855+-- that moment only if the old event does.

833856--

834857-- Because the simultaneous firing case is irrelevant, this function imposes

835858-- laxer "timing requirements" on the overall circuit, avoiding many potential

@@ -875,13 +898,13 @@ coincidencePatchMap e = fmapCheap PatchMap $ coincidence $ ffor e $ \(PatchMap m

875898 Nothing -> fmapCheap (const Nothing) e

876899 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]

877900

878−-- | See 'coincicencePatchMap'

901+-- | See 'coincidencePatchMap'

879902coincidencePatchIntMap :: Reflex t => Event t (PatchIntMap (Event t v)) -> Event t (PatchIntMap v)

880903coincidencePatchIntMap e = fmapCheap PatchIntMap $ coincidence $ ffor e $ \(PatchIntMap m) -> mergeIntMap $ ffor m $ \case

881904 Nothing -> fmapCheap (const Nothing) e

882905 Just ev -> leftmost [fmapCheap Just ev, fmapCheap (const Nothing) e]

883906

884−-- | See 'coincicencePatchMap'

907+-- | See 'coincidencePatchMap'

885908coincidencePatchMapWithMove :: (Reflex t, Ord k) => Event t (PatchMapWithMove k (Event t v)) -> Event t (PatchMapWithMove k v)

886909coincidencePatchMapWithMove e = fmapCheap unsafePatchMapWithMove $ coincidence $ ffor e $ \p -> mergeMap $ ffor (unPatchMapWithMove p) $ \ni -> case PatchMapWithMove._nodeInfo_from ni of

887910 PatchMapWithMove.From_Delete -> fforCheap e $ \_ ->

@@ -942,7 +965,7 @@ zipDyn = zipDynWith (,)

942965

943966-- | Combine two 'Dynamic's with a combining function. The result will change

944967-- whenever either (or both) input 'Dynamic' changes.

945−-- More efficient than liftA2.

968+-- More efficient than 'liftA2'.

946969zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c

947970zipDynWith f da db =

948971 let eab = align (updated da) (updated db)

@@ -973,7 +996,7 @@ instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where

973996

974997-- | This function converts a 'DMap' whose elements are 'Dynamic's into a

975998-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same

976−-- through the use of multiple uses of 'zipWithDyn' or 'Applicative' operators.

999+-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.

9771000distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)

9781001distributeDMapOverDynPure dm = case DMap.toList dm of

9791002 [] -> constDyn DMap.empty

@@ -999,14 +1022,16 @@ distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) .

9991022difference :: Reflex t => Event t a -> Event t b -> Event t a

10001023difference = alignEventWithMaybe $ \case

10011024 This a -> Just a

1002− _ -> Nothing

1025+ _ -> Nothing

10031026

1027+-- | Zips two values by taking the union of their shapes and combining with the provided function.

1028+-- 'Nothing' values are dropped.

10041029alignEventWithMaybe :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c

1005−alignEventWithMaybe f ea eb =

1006− fmapMaybe (f <=< dmapToThese)

1007− $ merge

1008− $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]

1030+alignEventWithMaybe f ea eb = mapMaybe (f <=< dmapToThese) $

1031+ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]

10091032

1033+-- | Produces an 'Event' that fires only when the input event fires with a 'DSum' key that

1034+-- matches the provided key.

10101035filterEventKey

10111036 :: forall t m k v a.

10121037 ( Reflex t

@@ -1024,7 +1049,10 @@ filterEventKey k kv' = do

10241049 Nothing -> Nothing

10251050 takeWhileJustE f kv'

10261051

1027−

1052+-- | "Factor" the input 'DSum' 'Event' to produce an 'Event' which

1053+-- fires when the 'DSum' key changes and contains both the value of the

1054+-- 'DSum' at switchover and an 'Event' of values produced by subsequent

1055+-- firings of the input 'Event' that do not change the 'DSum' key.

10281056factorEvent

10291057 :: forall t m k v a.

10301058 ( Reflex t

@@ -1074,26 +1102,94 @@ class Reflex t => Accumulator t f | f -> t where

10741102 mapAccumMaybe f = mapAccumMaybeM $ \v o -> return $ f v o

10751103 mapAccumMaybeM :: (MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (f a, Event t c)

10761104

1077−accumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Dynamic t a)

1105+-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'

1106+-- with the provided function. See 'foldDyn'.

1107+accumDyn

1108+ :: (Reflex t, MonadHold t m, MonadFix m)

1109+ => (a -> b -> a)

1110+ -> a

1111+ -> Event t b

1112+ -> m (Dynamic t a)

10781113accumDyn f = accumMaybeDyn $ \v o -> Just $ f v o

1079−accumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Dynamic t a)

1114+

1115+-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'

1116+-- with the provided 'PushM' action.

1117+accumMDyn

1118+ :: (Reflex t, MonadHold t m, MonadFix m)

1119+ => (a -> b -> PushM t a)

1120+ -> a

1121+ -> Event t b

1122+ -> m (Dynamic t a)

10801123accumMDyn f = accumMaybeMDyn $ \v o -> Just <$> f v o

1081−accumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Dynamic t a)

1124+

1125+-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'

1126+-- with the provided function, discarding 'Nothing' results.

1127+accumMaybeDyn

1128+ :: (Reflex t, MonadHold t m, MonadFix m)

1129+ => (a -> b -> Maybe a)

1130+ -> a

1131+ -> Event t b

1132+ -> m (Dynamic t a)

10821133accumMaybeDyn f = accumMaybeMDyn $ \v o -> return $ f v o

1083−accumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Dynamic t a)

1134+

1135+-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'

1136+-- with the provided 'PushM' action, discarding 'Nothing' results.

1137+accumMaybeMDyn

1138+ :: (Reflex t, MonadHold t m, MonadFix m)

1139+ => (a -> b -> PushM t (Maybe a))

1140+ -> a

1141+ -> Event t b

1142+ -> m (Dynamic t a)

10841143accumMaybeMDyn f z e = do

10851144 rec let e' = flip push e $ \o -> do

10861145 v <- sample $ current d'

10871146 f v o

10881147 d' <- holdDyn z e'

10891148 return d'

1090−mapAccumDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

1149+

1150+-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event'

1151+-- with a function that both accumulates and produces a value to fire

1152+-- as an 'Event'. Returns both the accumulated value and an 'Event'.

1153+mapAccumDyn

1154+ :: (Reflex t, MonadHold t m, MonadFix m)

1155+ => (a -> b -> (a, c))

1156+ -> a

1157+ -> Event t b

1158+ -> m (Dynamic t a, Event t c)

10911159mapAccumDyn f = mapAccumMaybeDyn $ \v o -> bimap Just Just $ f v o

1092−mapAccumMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

1160+

1161+-- | Similar to 'mapAccumDyn' except that the combining function is a

1162+-- 'PushM' action.

1163+mapAccumMDyn

1164+ :: (Reflex t, MonadHold t m, MonadFix m)

1165+ => (a -> b -> PushM t (a, c))

1166+ -> a

1167+ -> Event t b

1168+ -> m (Dynamic t a, Event t c)

10931169mapAccumMDyn f = mapAccumMaybeMDyn $ \v o -> bimap Just Just <$> f v o

1094−mapAccumMaybeDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

1170+

1171+-- | Accumulate a 'Dynamic' by folding occurrences of an 'Event' with

1172+-- a function that both optionally accumulates and optionally produces

1173+-- a value to fire as a separate output 'Event'.

1174+-- Note that because 'Nothing's are discarded in both cases, the output

1175+-- 'Event' may fire even though the output 'Dynamic' has not changed, and

1176+-- the output 'Dynamic' may update even when the output 'Event' is not firing.

1177+mapAccumMaybeDyn

1178+ :: (Reflex t, MonadHold t m, MonadFix m)

1179+ => (a -> b -> (Maybe a, Maybe c))

1180+ -> a

1181+ -> Event t b

1182+ -> m (Dynamic t a, Event t c)

10951183mapAccumMaybeDyn f = mapAccumMaybeMDyn $ \v o -> return $ f v o

1096−mapAccumMaybeMDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Dynamic t a, Event t c)

1184+

1185+-- | Like 'mapAccumMaybeDyn' except that the combining function is a

1186+-- 'PushM' action.

1187+mapAccumMaybeMDyn

1188+ :: (Reflex t, MonadHold t m, MonadFix m)

1189+ => (a -> b -> PushM t (Maybe a, Maybe c))

1190+ -> a

1191+ -> Event t b

1192+ -> m (Dynamic t a, Event t c)

10971193mapAccumMaybeMDyn f z e = do

10981194 rec let e' = flip push e $ \o -> do

10991195 v <- sample $ current d'

@@ -1101,18 +1197,42 @@ mapAccumMaybeMDyn f z e = do

11011197 return $ case result of

11021198 (Nothing, Nothing) -> Nothing

11031199 _ -> Just result

1104− d' <- holdDyn z $ fmapMaybe fst e'

1105− return (d', fmapMaybe snd e')

1200+ d' <- holdDyn z $ mapMaybe fst e'

1201+ return (d', mapMaybe snd e')

11061202

1203+-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'

1204+-- with the provided function.

11071205{-# INLINE accumB #-}

1108−accumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> a) -> a -> Event t b -> m (Behavior t a)

1206+accumB

1207+ :: (Reflex t, MonadHold t m, MonadFix m)

1208+ => (a -> b -> a)

1209+ -> a

1210+ -> Event t b

1211+ -> m (Behavior t a)

11091212accumB f = accumMaybeB $ \v o -> Just $ f v o

1213+

1214+-- | Like 'accumB' except that the combining function is a 'PushM' action.

11101215{-# INLINE accumMB #-}

1111−accumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t a) -> a -> Event t b -> m (Behavior t a)

1216+accumMB

1217+ :: (Reflex t, MonadHold t m, MonadFix m)

1218+ => (a -> b -> PushM t a)

1219+ -> a

1220+ -> Event t b

1221+ -> m (Behavior t a)

11121222accumMB f = accumMaybeMB $ \v o -> Just <$> f v o

1223+

1224+-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'

1225+-- with the provided function, discarding 'Nothing' results.

11131226{-# INLINE accumMaybeB #-}

1114−accumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe a) -> a -> Event t b -> m (Behavior t a)

1227+accumMaybeB

1228+ :: (Reflex t, MonadHold t m, MonadFix m)

1229+ => (a -> b -> Maybe a)

1230+ -> a

1231+ -> Event t b

1232+ -> m (Behavior t a)

11151233accumMaybeB f = accumMaybeMB $ \v o -> return $ f v o

1234+

1235+-- | Like 'accumMaybeB' except that the combining function is a 'PushM' action.

11161236{-# INLINE accumMaybeMB #-}

11171237accumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a)) -> a -> Event t b -> m (Behavior t a)

11181238accumMaybeMB f z e = do

@@ -1121,16 +1241,42 @@ accumMaybeMB f z e = do

11211241 f v o

11221242 d' <- hold z e'

11231243 return d'

1244+

1245+-- | Accumulate a 'Behavior' by folding occurrences of an 'Event'

1246+-- with a function that both accumulates and produces a value to fire

1247+-- as an 'Event'. Returns both the accumulated value and an 'Event'.

11241248{-# INLINE mapAccumB #-}

1125−mapAccumB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)

1249+mapAccumB

1250+ :: (Reflex t, MonadHold t m, MonadFix m)

1251+ => (a -> b -> (a, c))

1252+ -> a

1253+ -> Event t b

1254+ -> m (Behavior t a, Event t c)

11261255mapAccumB f = mapAccumMaybeB $ \v o -> bimap Just Just $ f v o

1256+

1257+-- | Like 'mapAccumB' except that the combining function is a 'PushM' action.

11271258{-# INLINE mapAccumMB #-}

1128−mapAccumMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (a, c)) -> a -> Event t b -> m (Behavior t a, Event t c)

1259+mapAccumMB

1260+ :: (Reflex t, MonadHold t m, MonadFix m)

1261+ => (a -> b -> PushM t (a, c))

1262+ -> a

1263+ -> Event t b

1264+ -> m (Behavior t a, Event t c)

11291265mapAccumMB f = mapAccumMaybeMB $ \v o -> bimap Just Just <$> f v o

1266+

1267+-- | Accumulate a 'Behavior' by folding occurrences of an 'Event' with

1268+-- a function that both optionally accumulates and optionally produces

1269+-- a value to fire as a separate output 'Event'. 'Nothing's are discarded.

11301270{-# INLINE mapAccumMaybeB #-}

1131−mapAccumMaybeB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

1271+mapAccumMaybeB

1272+ :: (Reflex t, MonadHold t m, MonadFix m)

1273+ => (a -> b -> (Maybe a, Maybe c))

1274+ -> a

1275+ -> Event t b

1276+ -> m (Behavior t a, Event t c)

11321277mapAccumMaybeB f = mapAccumMaybeMB $ \v o -> return $ f v o

11331278

1279+-- | LIke 'mapAccumMaybeB' except that the combining function is a 'PushM' action.

11341280{-# INLINE mapAccumMaybeMB #-}

11351281mapAccumMaybeMB :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe a, Maybe c)) -> a -> Event t b -> m (Behavior t a, Event t c)

11361282mapAccumMaybeMB f z e = do

@@ -1140,8 +1286,8 @@ mapAccumMaybeMB f z e = do

11401286 return $ case result of

11411287 (Nothing, Nothing) -> Nothing

11421288 _ -> Just result

1143− d' <- hold z $ fmapMaybe fst e'

1144− return (d', fmapMaybe snd e')

1289+ d' <- hold z $ mapMaybe fst e'

1290+ return (d', mapMaybe snd e')

11451291

11461292-- | Accumulate occurrences of an 'Event', producing an output occurrence each

11471293-- time. Discard the underlying 'Accumulator'.

@@ -1285,38 +1431,53 @@ infixl 4 <@

12851431-- Cheap Functions

12861432------------------

12871433

1434+-- | A "cheap" version of 'pushAlways'. See the performance note on 'pushCheap'.

12881435{-# INLINE pushAlwaysCheap #-}

12891436pushAlwaysCheap :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b

12901437pushAlwaysCheap f = pushCheap (fmap Just . f)

12911438

1439+-- | A "cheap" version of 'mapMaybe'. See the performance note on 'pushCheap'.

1440+{-# INLINE mapMaybeCheap #-}

1441+mapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b

1442+mapMaybeCheap f = pushCheap $ return . f

1443+

1444+-- | An alias for 'mapMaybeCheap'

12921445{-# INLINE fmapMaybeCheap #-}

12931446fmapMaybeCheap :: Reflex t => (a -> Maybe b) -> Event t a -> Event t b

1294−fmapMaybeCheap f = pushCheap $ return . f

1447+fmapMaybeCheap = mapMaybeCheap

1448+

12951449

1450+-- | A "cheap" version of 'fforMaybe'. See the performance note on 'pushCheap'.

12961451{-# INLINE fforMaybeCheap #-}

12971452fforMaybeCheap :: Reflex t => Event t a -> (a -> Maybe b) -> Event t b

1298−fforMaybeCheap = flip fmapMaybeCheap

1453+fforMaybeCheap = flip mapMaybeCheap

12991454

1455+-- | A "cheap" version of 'ffor'. See the performance note on 'pushCheap'.

13001456{-# INLINE fforCheap #-}

13011457fforCheap :: Reflex t => Event t a -> (a -> b) -> Event t b

13021458fforCheap = flip fmapCheap

13031459

1460+-- | A "cheap" version of 'fmap'. See the performance note on 'pushCheap'.

13041461{-# INLINE fmapCheap #-}

13051462fmapCheap :: Reflex t => (a -> b) -> Event t a -> Event t b

13061463fmapCheap f = pushCheap $ return . Just . f

13071464

1465+-- | A "cheap" version of 'tag'. See the performance note on 'pushCheap'.

13081466{-# INLINE tagCheap #-}

13091467tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b

13101468tagCheap b = pushAlwaysCheap $ \_ -> sample b

13111469

1470+-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.

13121471{-# INLINE mergeWithCheap #-}

13131472mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a

13141473mergeWithCheap = mergeWithCheap' id

13151474

1475+-- | A "cheap" version of 'mergeWithCheap''. See the performance note on 'pushCheap'.

13161476{-# INLINE mergeWithCheap' #-}

13171477mergeWithCheap' :: Reflex t => (a -> b) -> (b -> b -> b) -> [Event t a] -> Event t b

13181478mergeWithCheap' f g = mergeWithFoldCheap' $ foldl1 g . fmap f

13191479

1480+-- | A "cheap" version of 'mergeWithFoldCheap''. See the performance note on 'pushCheap'.

13201481{-# INLINE mergeWithFoldCheap' #-}

13211482mergeWithFoldCheap' :: Reflex t => (NonEmpty a -> b) -> [Event t a] -> Event t b

13221483mergeWithFoldCheap' f es =

@@ -1329,28 +1490,6 @@ mergeWithFoldCheap' f es =

13291490-- Deprecated functions

13301491--------------------------------------------------------------------------------

13311492

1332−-- | Create a new 'Event' that occurs if at least one of the supplied 'Event's

1333−-- occurs. If both occur at the same time they are combined using 'mappend'.

1334−{-# DEPRECATED appendEvents "If a 'Semigroup a' instance is available, use 'mappend'; otherwise, use 'alignWith (mergeThese mappend)' instead" #-}

1335−appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a

1336−appendEvents = alignWith $ mergeThese mappend

1337−

1338−-- | Alias for 'headE'

1339−{-# DEPRECATED onceE "Use 'headE' instead" #-}

1340−onceE :: MonadHold t m => Event t a -> m (Event t a)

1341−onceE = headE

1342−

1343−-- | Run both sides of a 'These' monadically, combining the results.

1344−{-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}

1345−#ifdef USE_TEMPLATE_HASKELL

1346−{-# ANN sequenceThese "HLint: ignore Use fmap" #-}

1347−#endif

1348−sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)

1349−sequenceThese t = case t of

1350− This ma -> fmap This ma

1351− These ma mb -> liftM2 These ma mb

1352− That mb -> fmap That mb

1353−

13541493{-# DEPRECATED switchPromptly "Use 'switchHoldPromptly' instead. The 'switchHold*' naming convention was chosen because those functions are more closely related to each other than they are to 'switch'. " #-}

13551494switchPromptly :: (Reflex t, MonadHold t m) => Event t a -> Event t (Event t a) -> m (Event t a)

13561495switchPromptly = switchHoldPromptly

src/Reflex/Collection.hs+150−53

@@ -10,12 +10,14 @@

1010#ifdef USE_REFLEX_OPTIMIZER

1111{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

1212#endif

13+-- |

14+-- Module:

15+-- Reflex.Collection

1316module Reflex.Collection

1417 (

1518 -- * Widgets on Collections

1619 listHoldWithKey

1720 , listWithKey

18− , listWithKey'

1921 , listWithKeyShallowDiff

2022 , listViewWithKey

2123 , selectViewListWithKey

@@ -38,84 +40,179 @@ import Reflex.Adjustable.Class

3840import Reflex.Dynamic

3941import Reflex.PostBuild.Class

4042

41−listHoldWithKey :: forall t m k v a. (Ord k, Adjustable t m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> m a) -> m (Dynamic t (Map k a))

43+-- | Create a set of widgets based on the provided 'Map'. When the

44+-- input 'Event' fires, remove widgets for keys with the value 'Nothing'

45+-- and add/replace widgets for keys with 'Just' values.

46+listHoldWithKey

47+ :: forall t m k v a

48+ . (Ord k, Adjustable t m, MonadHold t m)

49+ => Map k v

50+ -> Event t (Map k (Maybe v))

51+ -> (k -> v -> m a)

52+ -> m (Dynamic t (Map k a))

4253listHoldWithKey m0 m' f = do

4354 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0

44− dm' = fmap (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey (\k v -> ComposeMaybe $ fmap (f k) v)) m'

55+ dm' = fmap

56+ (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey

57+ (\k v -> ComposeMaybe $ fmap (f k) v)

58+ )

59+ m'

4560 (a0, a') <- sequenceDMapWithAdjust dm0 dm'

46− fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a' --TODO: Move the dmapToMap to the righthand side so it doesn't get fully redone every time

4761

48−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value

49−listWithKey :: forall t k v m a. (Ord k, Adjustable t m, PostBuild t m, MonadFix m, MonadHold t m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m a) -> m (Dynamic t (Map k a))

62+ --TODO: Move the dmapToMap to the righthand side so it doesn't get

63+ --fully redone every time

64+ fmap dmapToMap . incrementalToDynamic <$> holdIncremental a0 a'

65+

66+--TODO: Something better than Dynamic t (Map k v) - we want something

67+--where the Events carry diffs, not the whole value

68+listWithKey

69+ :: forall t k v m a

70+ . (Ord k, Adjustable t m, PostBuild t m, MonadFix m, MonadHold t m)

71+ => Dynamic t (Map k v)

72+ -> (k -> Dynamic t v -> m a)

73+ -> m (Dynamic t (Map k a))

5074listWithKey vals mkChild = do

5175 postBuild <- getPostBuild

5276 let childValChangedSelector = fanMap $ updated vals

53− -- We keep track of changes to children values in the mkChild function we pass to listHoldWithKey

54− -- The other changes we need to keep track of are child insertions and deletions. diffOnlyKeyChanges

55− -- keeps track of insertions and deletions but ignores value changes, since they're already accounted for.

56− diffOnlyKeyChanges olds news = flip Map.mapMaybe (align olds news) $ \case

57− This _ -> Just Nothing

58− These _ _ -> Nothing

59− That new -> Just $ Just new

77+

78+ -- We keep track of changes to children values in the mkChild

79+ -- function we pass to listHoldWithKey The other changes we need

80+ -- to keep track of are child insertions and

81+ -- deletions. diffOnlyKeyChanges keeps track of insertions and

82+ -- deletions but ignores value changes, since they're already

83+ -- accounted for.

84+ diffOnlyKeyChanges olds news =

85+ flip Map.mapMaybe (align olds news) $ \case

86+ This _ -> Just Nothing

87+ These _ _ -> Nothing

88+ That new -> Just $ Just new

6089 rec sentVals :: Dynamic t (Map k v) <- foldDyn applyMap Map.empty changeVals

6190 let changeVals :: Event t (Map k (Maybe v))

62− changeVals = attachWith diffOnlyKeyChanges (current sentVals) $ leftmost

63− [ updated vals

64− , tag (current vals) postBuild --TODO: This should probably be added to the attachWith, not to the updated; if we were using diffMap instead of diffMapNoEq, I think it might not work

65− ]

91+ changeVals =

92+ attachWith diffOnlyKeyChanges (current sentVals) $ leftmost

93+ [ updated vals

94+

95+ -- TODO: This should probably be added to the

96+ -- attachWith, not to the updated; if we were using

97+ -- diffMap instead of diffMapNoEq, I think it might not

98+ -- work

99+ , tag (current vals) postBuild

100+ ]

66101 listHoldWithKey Map.empty changeVals $ \k v ->

67102 mkChild k =<< holdDyn v (select childValChangedSelector $ Const2 k)

68103

69−{-# DEPRECATED listWithKey' "listWithKey' has been renamed to listWithKeyShallowDiff; also, its behavior has changed to fix a bug where children were always rebuilt (never updated)" #-}

70−listWithKey' :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))

71−listWithKey' = listWithKeyShallowDiff

72−

73−-- | Display the given map of items (in key order) using the builder function provided, and update it with the given event. 'Nothing' update entries will delete the corresponding children, and 'Just' entries will create them if they do not exist or send an update event to them if they do.

74−listWithKeyShallowDiff :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m) => Map k v -> Event t (Map k (Maybe v)) -> (k -> v -> Event t v -> m a) -> m (Dynamic t (Map k a))

104+-- | Display the given map of items (in key order) using the builder

105+-- function provided, and update it with the given event. 'Nothing'

106+-- update entries will delete the corresponding children, and 'Just'

107+-- entries will create them if they do not exist or send an update

108+-- event to them if they do.

109+listWithKeyShallowDiff

110+ :: (Ord k, Adjustable t m, MonadFix m, MonadHold t m)

111+ => Map k v

112+ -> Event t (Map k (Maybe v))

113+ -> (k -> v -> Event t v -> m a)

114+ -> m (Dynamic t (Map k a))

75115listWithKeyShallowDiff initialVals valsChanged mkChild = do

76116 let childValChangedSelector = fanMap $ fmap (Map.mapMaybe id) valsChanged

77117 sentVals <- foldDyn applyMap (void initialVals) $ fmap (fmap void) valsChanged

78118 let relevantPatch patch _ = case patch of

79− Nothing -> Just Nothing -- Even if we let a Nothing through when the element doesn't already exist, this doesn't cause a problem because it is ignored

80− Just _ -> Nothing -- We don't want to let spurious re-creations of items through

81− listHoldWithKey initialVals (attachWith (flip (Map.differenceWith relevantPatch)) (current sentVals) valsChanged) $ \k v ->

82− mkChild k v $ select childValChangedSelector $ Const2 k

83−

84−--TODO: Something better than Dynamic t (Map k v) - we want something where the Events carry diffs, not the whole value

85−-- | Create a dynamically-changing set of Event-valued widgets.

86−-- This is like listWithKey, specialized for widgets returning (Event t a). listWithKey would return 'Dynamic t (Map k (Event t a))' in this scenario, but listViewWithKey flattens this to 'Event t (Map k a)' via 'switch'.

87−listViewWithKey :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m (Event t a)) -> m (Event t (Map k a))

88−listViewWithKey vals mkChild = switch . fmap mergeMap <$> listViewWithKey' vals mkChild

89−

90−listViewWithKey' :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m) => Dynamic t (Map k v) -> (k -> Dynamic t v -> m a) -> m (Behavior t (Map k a))

119+

120+ -- Even if we let a Nothing through when the element doesn't

121+ -- already exist, this doesn't cause a problem because it is

122+ -- ignored

123+ Nothing -> Just Nothing

124+

125+ -- We don't want to let spurious re-creations of items through

126+ Just _ -> Nothing

127+ listHoldWithKey

128+ initialVals

129+ (attachWith (flip (Map.differenceWith relevantPatch))

130+ (current sentVals)

131+ valsChanged

132+ )

133+ $ \k v -> mkChild k v $ select childValChangedSelector $ Const2 k

134+

135+--TODO: Something better than Dynamic t (Map k v) - we want something

136+--where the Events carry diffs, not the whole value

137+-- | Create a dynamically-changing set of Event-valued widgets. This

138+-- is like 'listWithKey', specialized for widgets returning @/Event t a/@.

139+-- 'listWithKey' would return @/Dynamic t (Map k (Event t a))/@ in

140+-- this scenario, but 'listViewWithKey' flattens this to

141+-- @/Event t (Map k a)/@ via 'switch'.

142+listViewWithKey

143+ :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)

144+ => Dynamic t (Map k v)

145+ -> (k -> Dynamic t v -> m (Event t a))

146+ -> m (Event t (Map k a))

147+listViewWithKey vals mkChild =

148+ switch . fmap mergeMap <$> listViewWithKey' vals mkChild

149+

150+listViewWithKey'

151+ :: (Ord k, Adjustable t m, PostBuild t m, MonadHold t m, MonadFix m)

152+ => Dynamic t (Map k v)

153+ -> (k -> Dynamic t v -> m a)

154+ -> m (Behavior t (Map k a))

91155listViewWithKey' vals mkChild = current <$> listWithKey vals mkChild

92156

93−-- | Create a dynamically-changing set of widgets, one of which is selected at any time.

94−selectViewListWithKey :: forall t m k v a. (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)

95− => Dynamic t k -- ^ Current selection key

96− -> Dynamic t (Map k v) -- ^ Dynamic key/value map

97− -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -- ^ Function to create a widget for a given key from Dynamic value and Dynamic Bool indicating if this widget is currently selected

98− -> m (Event t (k, a)) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.

157+-- | Create a dynamically-changing set of widgets, one of which is

158+-- selected at any time.

159+selectViewListWithKey

160+ :: forall t m k v a

161+ . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)

162+ => Dynamic t k

163+ -- ^ Current selection key

164+ -> Dynamic t (Map k v)

165+ -- ^ Dynamic key/value map

166+ -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))

167+ -- ^ Function to create a widget for a given key from Dynamic value

168+ -- and Dynamic Bool indicating if this widget is currently selected

169+ -> m (Event t (k, a))

170+ -- ^ Event that fires when any child's return Event fires. Contains

171+ -- key of an arbitrary firing widget.

99172selectViewListWithKey selection vals mkChild = do

100− let selectionDemux = demux selection -- For good performance, this value must be shared across all children

173+ -- For good performance, this value must be shared across all children

174+ let selectionDemux = demux selection

101175 selectChild <- listWithKey vals $ \k v -> do

102176 let selected = demuxed selectionDemux k

103177 selectSelf <- mkChild k v selected

104178 return $ fmap ((,) k) selectSelf

105179 return $ switchPromptlyDyn $ leftmost . Map.elems <$> selectChild

106180

107−selectViewListWithKey_ :: forall t m k v a. (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)

108− => Dynamic t k -- ^ Current selection key

109− -> Dynamic t (Map k v) -- ^ Dynamic key/value map

110− -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a)) -- ^ Function to create a widget for a given key from Dynamic value and Dynamic Bool indicating if this widget is currently selected

111− -> m (Event t k) -- ^ Event that fires when any child's return Event fires. Contains key of an arbitrary firing widget.

112−selectViewListWithKey_ selection vals mkChild = fmap fst <$> selectViewListWithKey selection vals mkChild

181+-- | Like 'selectViewListWithKey' but discards the value of the list

182+-- item widget's output 'Event'.

183+selectViewListWithKey_

184+ :: forall t m k v a

185+ . (Adjustable t m, Ord k, PostBuild t m, MonadHold t m, MonadFix m)

186+ => Dynamic t k

187+ -- ^ Current selection key

188+ -> Dynamic t (Map k v)

189+ -- ^ Dynamic key/value map

190+ -> (k -> Dynamic t v -> Dynamic t Bool -> m (Event t a))

191+ -- ^ Function to create a widget for a given key from Dynamic value

192+ -- and Dynamic Bool indicating if this widget is currently selected

193+ -> m (Event t k)

194+ -- ^ Event that fires when any child's return Event fires. Contains

195+ -- key of an arbitrary firing widget.

196+selectViewListWithKey_ selection vals mkChild =

197+ fmap fst <$> selectViewListWithKey selection vals mkChild

113198

114−-- | Create a dynamically-changing set of widgets from a Dynamic key/value map.

115−-- Unlike the 'withKey' variants, the child widgets are insensitive to which key they're associated with.

116−list :: (Ord k, Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m) => Dynamic t (Map k v) -> (Dynamic t v -> m a) -> m (Dynamic t (Map k a))

199+-- | Create a dynamically-changing set of widgets from a Dynamic

200+-- key/value map. Unlike the 'withKey' variants, the child widgets

201+-- are insensitive to which key they're associated with.

202+list

203+ :: (Ord k, Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)

204+ => Dynamic t (Map k v)

205+ -> (Dynamic t v -> m a)

206+ -> m (Dynamic t (Map k a))

117207list dm mkChild = listWithKey dm (\_ dv -> mkChild dv)

118208

119209-- | Create a dynamically-changing set of widgets from a Dynamic list.

120−simpleList :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m) => Dynamic t [v] -> (Dynamic t v -> m a) -> m (Dynamic t [a])

121−simpleList xs mkChild = fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap (Map.fromList . zip [(1::Int)..]) xs

210+simpleList

211+ :: (Adjustable t m, MonadHold t m, PostBuild t m, MonadFix m)

212+ => Dynamic t [v]

213+ -> (Dynamic t v -> m a)

214+ -> m (Dynamic t [a])

215+simpleList xs mkChild =

216+ fmap (fmap (map snd . Map.toList)) $ flip list mkChild $ fmap

217+ (Map.fromList . zip [(1 :: Int) ..])

218+ xs

src/Reflex/Dynamic.hs+27−175

@@ -17,8 +17,12 @@

1717#ifdef USE_REFLEX_OPTIMIZER

1818{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

1919#endif

20−-- | This module contains various functions for working with 'Dynamic' values.

21−-- 'Dynamic' and its primitives have been moved to the 'Reflex' class.

20+-- |

21+-- Module:

22+-- Reflex.Dynamic

23+-- Description:

24+-- This module contains various functions for working with 'Dynamic' values.

25+-- 'Dynamic' and its primitives have been moved to the 'Reflex' class.

2226module Reflex.Dynamic

2327 ( -- * Basics

2428 Dynamic -- Abstract so we can preserve the law that the current value is always equal to the most recent update

@@ -58,6 +62,7 @@ module Reflex.Dynamic

5862 , Demux

5963 , demux

6064 , demuxed

65+ -- * Miscellaneous

6166 -- Things that probably aren't very useful:

6267 , HList (..)

6368 , FHList (..)

@@ -67,34 +72,14 @@ module Reflex.Dynamic

6772 , AllAreFunctors (..)

6873 , HListPtr (..)

6974 , distributeFHListOverDynPure

70− -- Unsafe

75+ -- * Unsafe

7176 , unsafeDynamic

72− -- * Deprecated functions

73− , apDyn

74− , attachDyn

75− , attachDynWith

76− , attachDynWithMaybe

77− , collectDyn

78− , combineDyn

79− , distributeDMapOverDyn

80− , distributeFHListOverDyn

81− , forDyn

82− , getDemuxed

83− , joinDyn

84− , mapDyn

85− , mconcatDyn

86− , nubDyn

87− , splitDyn

88− , tagDyn

89− , uniqDyn

90− , uniqDynBy

9177 ) where

9278

9379import Data.Functor.Compose

9480import Data.Functor.Misc

9581import Reflex.Class

9682

97−import Control.Applicative ((<*>))

9883import Control.Monad

9984import Control.Monad.Fix

10085import Control.Monad.Identity

@@ -102,11 +87,10 @@ import Data.Align

10287import Data.Dependent.Map (DMap)

10388import qualified Data.Dependent.Map as DMap

10489import Data.Dependent.Sum (DSum (..))

105−import Data.Functor.Product

10690import Data.GADT.Compare ((:~:) (..), GCompare (..), GEq (..), GOrdering (..))

10791import Data.Map (Map)

10892import Data.Maybe

109−import Data.Monoid hiding (Product)

93+import Data.Monoid ((<>))

11094import Data.These

11195

11296import Debug.Trace

@@ -130,7 +114,7 @@ holdUniqDyn = holdUniqDynBy (==)

130114holdUniqDynBy :: (Reflex t, MonadHold t m, MonadFix m) => (a -> a -> Bool) -> Dynamic t a -> m (Dynamic t a)

131115holdUniqDynBy eq = scanDynMaybe id (\new old -> if new `eq` old then Nothing else Just new)

132116

133−-- | Dynamic Maybe that can only update from Nothing to Just or Just to Just (i.e., cannot revert to Nothing)

117+-- | @/Dynamic Maybe/@ that can only update from @/Nothing/@ to @/Just/@ or @/Just/@ to @/Just/@ (i.e., cannot revert to @/Nothing/@)

134118improvingMaybe :: (Reflex t, MonadHold t m, MonadFix m) => Dynamic t (Maybe a) -> m (Dynamic t (Maybe a))

135119improvingMaybe = scanDynMaybe id (\new _ -> if isJust new then Just new else Nothing)

136120

@@ -195,9 +179,9 @@ switchDyn :: forall t a. Reflex t => Dynamic t (Event t a) -> Event t a

195179switchDyn d = switch (current d)

196180

197181-- | Switches to the new 'Event' whenever it receives one. Switching occurs

198−-- *before* the inner 'Event' fires - so if the 'Dynamic' changes and both the

182+-- __before__ the inner 'Event' fires - so if the 'Dynamic' changes and both the

199183-- old and new inner Events fire simultaneously, the output will fire with the

200−-- value of the *new* 'Event'.

184+-- value of the __new__ 'Event'.

201185--

202186-- Prefer 'switchDyn' to this where possible. The timing requirements that

203187-- switching before imposes are likely to bring down your app unless you are

@@ -235,10 +219,10 @@ distributeListOverDynPure =

235219-- | Combine a 'Dynamic' of a 'Map' of 'Dynamic's into a 'Dynamic'

236220-- with the current values of the 'Dynamic's in a map.

237221joinDynThroughMap :: forall t k a. (Reflex t, Ord k) => Dynamic t (Map k (Dynamic t a)) -> Dynamic t (Map k a)

238−joinDynThroughMap = joinDyn . fmap distributeMapOverDynPure

222+joinDynThroughMap = join . fmap distributeMapOverDynPure

239223

240224-- | Print the value of the 'Dynamic' when it is first read and on each

241−-- subsequent change that is observed (as traceEvent), prefixed with the

225+-- subsequent change that is observed (as 'traceEvent'), prefixed with the

242226-- provided string. This should /only/ be used for debugging.

243227--

244228-- Note: Just like Debug.Trace.trace, the value will only be shown if something

@@ -248,7 +232,7 @@ traceDyn s = traceDynWith $ \x -> s <> ": " <> show x

248232

249233-- | Print the result of applying the provided function to the value

250234-- of the 'Dynamic' when it is first read and on each subsequent change

251−-- that is observed (as traceEvent). This should /only/ be used for

235+-- that is observed (as 'traceEvent'). This should /only/ be used for

252236-- debugging.

253237--

254238-- Note: Just like Debug.Trace.trace, the value will only be shown if something

@@ -264,27 +248,27 @@ traceDynWith f d =

264248-- | Replace the value of the 'Event' with the current value of the 'Dynamic'

265249-- each time the 'Event' occurs.

266250--

267−-- Note: `tagPromptlyDyn d e` differs from `tag (current d) e` in the case that `e` is firing

268−-- at the same time that `d` is changing. With `tagPromptlyDyn d e`, the *new* value of `d`

269−-- will replace the value of `e`, whereas with `tag (current d) e`, the *old* value

251+-- Note: @/tagPromptlyDyn d e/@ differs from @/tag (current d) e/@ in the case that @/e/@ is firing

252+-- at the same time that @/d/@ is changing. With @/tagPromptlyDyn d e/@, the __new__ value of @/d/@

253+-- will replace the value of @/e/@, whereas with @/tag (current d) e/@, the __old__ value

270254-- will be used, since the 'Behavior' won't be updated until the end of the frame.

271255-- Additionally, this means that the output 'Event' may not be used to directly change

272−-- the input 'Dynamic', because that would mean its value depends on itself. When creating

273−-- cyclic data flows, generally `tag (current d) e` is preferred.

256+-- the input 'Dynamic', because that would mean its value depends on itself. __When creating__

257+-- __cyclic data flows, generally @/tag (current d) e/@ is preferred.__

274258tagPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a

275259tagPromptlyDyn = attachPromptlyDynWith const

276260

277261-- | Attach the current value of the 'Dynamic' to the value of the

278262-- 'Event' each time it occurs.

279263--

280−-- Note: `attachPromptlyDyn d` is not the same as `attach (current d)`. See 'tagPromptlyDyn' for details.

264+-- Note: @/attachPromptlyDyn d/@ is not the same as @/attach (current d)/@. See 'tagPromptlyDyn' for details.

281265attachPromptlyDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)

282266attachPromptlyDyn = attachPromptlyDynWith (,)

283267

284268-- | Combine the current value of the 'Dynamic' with the value of the

285269-- 'Event' each time it occurs.

286270--

287−-- Note: `attachPromptlyDynWith f d` is not the same as `attachWith f (current d)`. See 'tagPromptlyDyn' for details.

271+-- Note: @/attachPromptlyDynWith f d/@ is not the same as @/attachWith f (current d)/@. See 'tagPromptlyDyn' for details.

288272attachPromptlyDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c

289273attachPromptlyDynWith f = attachPromptlyDynWithMaybe $ \a b -> Just $ f a b

290274

@@ -292,8 +276,7 @@ attachPromptlyDynWith f = attachPromptlyDynWithMaybe $ \a b -> Just $ f a b

292276-- current value of the 'Dynamic' value and possibly filtering if the combining

293277-- function returns 'Nothing'.

294278--

295−-- Note: `attachPromptlyDynWithMaybe f d` is not the same as `attachWithMaybe f

296−-- (current d)`. See 'tagPromptlyDyn' for details.

279+-- Note: @/attachPromptlyDynWithMaybe f d/@ is not the same as @/attachWithMaybe f (current d)/@. See 'tagPromptlyDyn' for details.

297280attachPromptlyDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c

298281attachPromptlyDynWithMaybe f d e =

299282 let e' = attach (current d) e

@@ -302,8 +285,8 @@ attachPromptlyDynWithMaybe f d e =

302285 These (_, b) a -> f a b -- Both events are firing, so use the newer value

303286 That _ -> Nothing -- The tagging event isn't firing, so don't fire

304287

305−-- | Factor a @Dynamic t (Maybe a)@ into a @Dynamic t (Maybe (Dynamic t a))@,

306−-- such that the outer 'Dynamic' is updated only when the 'Maybe''s constructor

288+-- | Factor a @/Dynamic t (Maybe a)/@ into a @/Dynamic t (Maybe (Dynamic t a))/@,

289+-- such that the outer 'Dynamic' is updated only when the "Maybe"'s constructor

307290-- chages from 'Nothing' to 'Just' or vice-versa. Whenever the constructor

308291-- becomes 'Just', an inner 'Dynamic' will be provided, whose value will track

309292-- the 'a' inside the 'Just'; when the constructor becomes 'Nothing', the

@@ -352,7 +335,7 @@ factorDyn d = buildDynamic (sample (current d) >>= holdKey) update where

352335--

353336-- > demuxed (demux d) k === fmap (== k) d

354337--

355−-- However, the when getDemuxed is used multiple times, the complexity is only

338+-- However, when getDemuxed is used multiple times, the complexity is only

356339-- /O(log(n))/, rather than /O(n)/ for fmap.

357340data Demux t k = Demux { demuxValue :: Behavior t k

358341 , demuxSelector :: EventSelector t (Const2 k Bool)

@@ -506,7 +489,7 @@ instance AllAreFunctors f t => AllAreFunctors f (h ': t) where

506489

507490-- | Convert a datastructure whose constituent parts are all 'Dynamic's into a

508491-- single 'Dynamic' whose value represents all the current values of the input's

509−-- consitutent 'Dynamic's.

492+-- constituent 'Dynamic's.

510493collectDynPure :: ( RebuildSortedHList (HListElems b)

511494 , IsHList a, IsHList b

512495 , AllAreFunctors (Dynamic t) (HListElems b)

@@ -547,134 +530,3 @@ instance IsHList (a, b, c, d, e, f) where

547530#if !defined(__GLASGOW_HASKELL__) || __GLASGOW_HASKELL__ < 800

548531 _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139

549532#endif

550−

551−--------------------------------------------------------------------------------

552−-- Deprecated functions

553−--------------------------------------------------------------------------------

554−

555−-- | Map a function over a 'Dynamic'.

556−{-# DEPRECATED mapDyn "Use 'return . fmap f' instead of 'mapDyn f'; consider eliminating monadic style" #-}

557−mapDyn :: (Reflex t, Monad m) => (a -> b) -> Dynamic t a -> m (Dynamic t b)

558−mapDyn f = return . fmap f

559−

560−-- | Flipped version of 'mapDyn'.

561−{-# DEPRECATED forDyn "Use 'return . ffor a' instead of 'forDyn a'; consider eliminating monadic style" #-}

562−forDyn :: (Reflex t, Monad m) => Dynamic t a -> (a -> b) -> m (Dynamic t b)

563−forDyn a = return . ffor a

564−

565−-- | Split the 'Dynamic' into two 'Dynamic's, each taking the respective value

566−-- of the tuple.

567−{-# DEPRECATED splitDyn "Use 'return . splitDynPure' instead; consider eliminating monadic style" #-}

568−splitDyn :: (Reflex t, Monad m) => Dynamic t (a, b) -> m (Dynamic t a, Dynamic t b)

569−splitDyn = return . splitDynPure

570−

571−-- | Merge the 'Dynamic' values using their 'Monoid' instance.

572−{-# DEPRECATED mconcatDyn "Use 'return . mconcat' instead; consider eliminating monadic style" #-}

573−mconcatDyn :: forall t m a. (Reflex t, Monad m, Monoid a) => [Dynamic t a] -> m (Dynamic t a)

574−mconcatDyn = return . mconcat

575−

576−-- | This function no longer needs to be monadic; see 'distributeMapOverDynPure'.

577−{-# DEPRECATED distributeDMapOverDyn "Use 'return . distributeDMapOverDynPure' instead; consider eliminating monadic style" #-}

578−distributeDMapOverDyn :: (Reflex t, Monad m, GCompare k) => DMap k (Dynamic t) -> m (Dynamic t (DMap k Identity))

579−distributeDMapOverDyn = return . distributeDMapOverDynPure

580−

581−-- | Merge two 'Dynamic's into a new one using the provided function. The new

582−-- 'Dynamic' changes its value each time one of the original 'Dynamic's changes

583−-- its value.

584−{-# DEPRECATED combineDyn "Use 'return (zipDynWith f a b)' instead of 'combineDyn f a b'; consider eliminating monadic style" #-}

585−combineDyn :: forall t m a b c. (Reflex t, Monad m) => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> m (Dynamic t c)

586−combineDyn f a b = return $ zipDynWith f a b

587−

588−-- | A psuedo applicative version of ap for 'Dynamic'. Example useage:

589−--

590−-- > do

591−-- > person <- Person `mapDyn` dynFirstName

592−-- > `apDyn` dynListName

593−-- > `apDyn` dynAge

594−-- > `apDyn` dynAddress

595−{-# DEPRECATED apDyn "Use 'ffor m (<*> a)' instead of 'apDyn m a'; consider eliminating monadic style, since Dynamics are now Applicative and can be used with applicative style directly" #-}

596−#ifdef USE_TEMPLATE_HASKELL

597−{-# ANN apDyn "HLint: ignore Use fmap" #-}

598−#endif

599−apDyn :: forall t m a b. (Reflex t, Monad m)

600− => m (Dynamic t (a -> b))

601− -> Dynamic t a

602− -> m (Dynamic t b)

603−apDyn m a = fmap (<*> a) m

604−

605−--TODO: The pattern of using hold (sample b0) can be reused in various places as a safe way of building certain kinds of Dynamics; see if we can factor this out

606−-- | This function no longer needs to be monadic, so it has been replaced by

607−-- 'demuxed', which is pure.

608−{-# DEPRECATED getDemuxed "Use 'return . demuxed d' instead of 'getDemuxed d'; consider eliminating monadic style" #-}

609−getDemuxed :: (Reflex t, Monad m, Eq k) => Demux t k -> k -> m (Dynamic t Bool)

610−getDemuxed d = return . demuxed d

611−

612−-- | This function no longer needs to be monadic, so it has been replaced by

613−-- 'distributeFHListOverDynPure', which is pure.

614−{-# DEPRECATED distributeFHListOverDyn "Use 'return . distributeFHListOverDynPure' instead; consider eliminating monadic style" #-}

615−distributeFHListOverDyn :: forall t m l. (Reflex t, Monad m, RebuildSortedHList l) => FHList (Dynamic t) l -> m (Dynamic t (HList l))

616−distributeFHListOverDyn = return . distributeFHListOverDynPure

617−

618−-- | This function no longer needs to be monadic, so it has been replaced by

619−-- 'collectDynPure', which is pure.

620−{-# DEPRECATED collectDyn "Use 'return . collectDynPure' instead; consider eliminating monadic style" #-}

621−collectDyn :: ( RebuildSortedHList (HListElems b)

622− , IsHList a, IsHList b

623− , AllAreFunctors (Dynamic t) (HListElems b)

624− , Reflex t, Monad m

625− , HListElems a ~ FunctorList (Dynamic t) (HListElems b)

626− ) => a -> m (Dynamic t b)

627−collectDyn = return . collectDynPure

628−

629−-- | This function has been renamed to 'tagPromptlyDyn' to clarify its

630−-- semantics.

631−{-# DEPRECATED tagDyn "Use 'tagPromptlyDyn' instead" #-}

632−tagDyn :: Reflex t => Dynamic t a -> Event t b -> Event t a

633−tagDyn = tagPromptlyDyn

634−

635−-- | This function has been renamed to 'attachPromptlyDyn' to clarify its

636−-- semantics.

637−{-# DEPRECATED attachDyn "Use 'attachPromptlyDyn' instead" #-}

638−attachDyn :: Reflex t => Dynamic t a -> Event t b -> Event t (a, b)

639−attachDyn = attachPromptlyDyn

640−

641−-- | This function has been renamed to 'attachPromptlyDynWith' to clarify its

642−-- semantics.

643−{-# DEPRECATED attachDynWith "Use 'attachPromptlyDynWith' instead" #-}

644−attachDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Event t b -> Event t c

645−attachDynWith = attachPromptlyDynWith

646−

647−-- | This function has been renamed to 'attachPromptlyDynWithMaybe' to clarify

648−-- its semantics.

649−{-# DEPRECATED attachDynWithMaybe "Use 'attachPromptlyDynWithMaybe' instead" #-}

650−attachDynWithMaybe :: Reflex t => (a -> b -> Maybe c) -> Dynamic t a -> Event t b -> Event t c

651−attachDynWithMaybe = attachPromptlyDynWithMaybe

652−

653−-- | Combine an inner and outer 'Dynamic' such that the resulting 'Dynamic''s

654−-- current value will always be equal to the current value's current value, and

655−-- will change whenever either the inner or the outer (or both) values change.

656−{-# DEPRECATED joinDyn "Use 'join' instead" #-}

657−joinDyn :: Reflex t => Dynamic t (Dynamic t a) -> Dynamic t a

658−joinDyn = join

659−

660−-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests

661−-- representational equality. Use 'holdUniqDyn' instead, which is pure in all

662−-- circumstances. Also, note that, unlike 'nub', this function does not prevent

663−-- all recurrences of a value, only consecutive recurrences.

664−{-# DEPRECATED nubDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}

665−nubDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a

666−nubDyn = uniqDyn

667−

668−-- | WARNING: This function is only pure if @a@'s 'Eq' instance tests

669−-- representational equality. Use 'holdUniqDyn' instead, which is pure in all

670−-- circumstances.

671−{-# DEPRECATED uniqDyn "Use 'holdUniqDyn' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}

672−uniqDyn :: (Reflex t, Eq a) => Dynamic t a -> Dynamic t a

673−uniqDyn = uniqDynBy (==)

674−

675−-- | WARNING: This function is impure. Use 'holdUniqDynBy' instead.

676−{-# DEPRECATED uniqDynBy "Use 'holdUniqDynBy' instead; note that it returns a MonadHold action rather than a pure Dynamic" #-}

677−uniqDynBy :: Reflex t => (a -> a -> Bool) -> Dynamic t a -> Dynamic t a

678−uniqDynBy eq d =

679− let e' = attachWithMaybe (\x x' -> if x' `eq` x then Nothing else Just x') (current d) (updated d)

680− in unsafeDynamic (current d) e'

src/Reflex/Dynamic/TH.hs+1−25

@@ -13,9 +13,6 @@ module Reflex.Dynamic.TH

1313 ( qDynPure

1414 , unqDyn

1515 , mkDynPure

16− -- * Deprecated functions

17− , qDyn

18− , mkDyn

1916 ) where

2017

2118import Reflex.Dynamic

@@ -23,7 +20,7 @@ import Reflex.Dynamic

2320import Control.Monad.State

2421import Data.Data

2522import Data.Generics

26−import Data.Monoid

23+import Data.Monoid ((<>))

2724import qualified Language.Haskell.Exts as Hs

2825import qualified Language.Haskell.Meta.Syntax.Translate as Hs

2926import Language.Haskell.TH

@@ -107,24 +104,3 @@ mkDynExp s = case Hs.parseExpWithMode (Hs.defaultParseMode { Hs.extensions = [ H

107104 reinstateUnqDyn (TH.Name (TH.OccName occName') (TH.NameQ (TH.ModName modName')))

108105 | modName == modName' && occName == occName' = 'unqMarker

109106 reinstateUnqDyn x = x

110−

111−--------------------------------------------------------------------------------

112−-- Deprecated

113−--------------------------------------------------------------------------------

114−

115−{-# DEPRECATED qDyn "Instead of $(qDyn x), use return $(qDynPure x)" #-}

116−-- | Like 'qDynPure', but wraps its result monadically using 'return'. This is

117−-- no longer necessary, due to 'Dynamic' being an instance of 'Functor'.

118−qDyn :: Q Exp -> Q Exp

119−qDyn qe = [| return $(qDynPure qe) |]

120−

121−{-# DEPRECATED mkDyn "Instead of [mkDyn| x |], use return [mkDynPure| x |]" #-}

122−-- | Like 'mkDynPure', but wraps its result monadically using 'return'. This is

123−-- no longer necessary, due to 'Dynamic' being an instance of 'Functor'.

124−mkDyn :: QuasiQuoter

125−mkDyn = QuasiQuoter

126− { quoteExp = \s -> [| return $(mkDynExp s) |]

127− , quotePat = error "mkDyn: pattern splices are not supported"

128− , quoteType = error "mkDyn: type splices are not supported"

129− , quoteDec = error "mkDyn: declaration splices are not supported"

130− }

src/Reflex/DynamicWriter/Base.hs+8−3

@@ -22,6 +22,7 @@ module Reflex.DynamicWriter.Base

2222import Control.Monad.Exception

2323import Control.Monad.Identity

2424import Control.Monad.IO.Class

25+import Control.Monad.Primitive

2526import Control.Monad.Reader

2627import Control.Monad.Ref

2728import Control.Monad.State.Strict

@@ -34,7 +35,7 @@ import Data.IntMap (IntMap)

3435import qualified Data.IntMap as IntMap

3536import Data.Map (Map)

3637import qualified Data.Map as Map

37−import Data.Semigroup

38+import Data.Semigroup (Semigroup(..))

3839import Data.Some (Some)

3940import Data.These

4041

@@ -87,7 +88,7 @@ mergeDynIncrementalWithMove a = unsafeBuildIncremental (mapM (sample . current)

8788 noLongerMovedMap = Map.fromList $ fmap (, ()) noLongerMoved

8889 in Map.differenceWith (\e _ -> Just $ MapWithMove.nodeInfoSetTo Nothing e) pWithNewVals noLongerMovedMap --TODO: Check if any in the second map are not covered?

8990

90−-- | A basic implementation of 'MonadDynamicWriter'.

91+-- | A basic implementation of 'DynamicWriter'.

9192newtype DynamicWriterT t w m a = DynamicWriterT { unDynamicWriterT :: StateT [Dynamic t w] m a }

9293 deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadAsyncException, MonadException) -- The list is kept in reverse order

9394

@@ -115,7 +116,7 @@ runDynamicWriterT (DynamicWriterT a) = do

115116 (result, ws) <- runStateT a []

116117 return (result, mconcat $ reverse ws)

117118

118−instance (Monad m, Monoid w, Reflex t) => MonadDynamicWriter t w (DynamicWriterT t w m) where

119+instance (Monad m, Monoid w, Reflex t) => DynamicWriter t w (DynamicWriterT t w m) where

119120 tellDyn w = DynamicWriterT $ modify (w :)

120121

121122instance MonadReader r m => MonadReader r (DynamicWriterT t w m) where

@@ -140,6 +141,10 @@ instance MonadState s m => MonadState s (DynamicWriterT t w m) where

140141 get = lift get

141142 put = lift . put

142143

144+instance PrimMonad m => PrimMonad (DynamicWriterT t w m) where

145+ type PrimState (DynamicWriterT t w m) = PrimState m

146+ primitive = lift . primitive

147+

143148newtype DynamicWriterTLoweredResult t w v a = DynamicWriterTLoweredResult (v a, Dynamic t w)

144149

145150-- | When the execution of a 'DynamicWriterT' action is adjusted using

src/Reflex/DynamicWriter/Class.hs+9−4

@@ -1,4 +1,5 @@

1−-- | This module defines the 'MonadDynamicWriter' class.

1+-- | This module defines the 'DynamicWriter' class.

2+{-# LANGUAGE ConstraintKinds #-}

23{-# LANGUAGE CPP #-}

34{-# LANGUAGE FlexibleInstances #-}

45{-# LANGUAGE FunctionalDependencies #-}

@@ -8,17 +9,21 @@

89{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

910#endif

1011module Reflex.DynamicWriter.Class

11− ( MonadDynamicWriter (..)

12+ ( MonadDynamicWriter

13+ , DynamicWriter(..)

1214 ) where

1315

1416import Control.Monad.Reader (ReaderT, lift)

1517import Reflex.Class (Dynamic)

1618

19+{-# DEPRECATED MonadDynamicWriter "Use 'DynamicWriter' instead" #-}

20+type MonadDynamicWriter = DynamicWriter

21+

1722-- | 'MonadDynamicWriter' efficiently collects 'Dynamic' values using 'tellDyn'

1823-- and combines them monoidally to provide a 'Dynamic' result.

19−class (Monad m, Monoid w) => MonadDynamicWriter t w m | m -> t w where

24+class (Monad m, Monoid w) => DynamicWriter t w m | m -> t w where

2025 tellDyn :: Dynamic t w -> m ()

2126

22−instance MonadDynamicWriter t w m => MonadDynamicWriter t w (ReaderT r m) where

27+instance DynamicWriter t w m => DynamicWriter t w (ReaderT r m) where

2328 tellDyn = lift . tellDyn

2429

src/Reflex/EventWriter/Base.hs+2−2

@@ -25,7 +25,7 @@ module Reflex.EventWriter.Base

2525import Reflex.Adjustable.Class

2626import Reflex.Class

2727import Reflex.EventWriter.Class (EventWriter, tellEvent)

28−import Reflex.DynamicWriter.Class (MonadDynamicWriter, tellDyn)

28+import Reflex.DynamicWriter.Class (DynamicWriter, tellDyn)

2929import Reflex.Host.Class

3030import Reflex.PerformEvent.Class

3131import Reflex.PostBuild.Class

@@ -278,7 +278,7 @@ instance (MonadQuery t q m, Monad m) => MonadQuery t q (EventWriterT t w m) wher

278278 askQueryResult = lift askQueryResult

279279 queryIncremental = lift . queryIncremental

280280

281−instance MonadDynamicWriter t w m => MonadDynamicWriter t w (EventWriterT t v m) where

281+instance DynamicWriter t w m => DynamicWriter t w (EventWriterT t v m) where

282282 tellDyn = lift . tellDyn

283283

284284instance PrimMonad m => PrimMonad (EventWriterT t w m) where

src/Reflex/FastWeak.hs+59−5

@@ -5,6 +5,19 @@

55{-# LANGUAGE ForeignFunctionInterface #-}

66{-# LANGUAGE JavaScriptFFI #-}

77#endif

9+-- |

10+-- Module:

11+-- Reflex.FastWeak

12+-- Description:

13+-- 'FastWeak' is a weak pointer to some value, and 'FastWeakTicket' ensures the value

14+-- referred to by a 'FastWeak' stays live while the ticket is held (live).

15+--

16+-- On GHC or GHCJS when not built with the @fast-weak@ cabal flag, 'FastWeak' is a wrapper

17+-- around the simple version of 'System.Mem.Weak.Weak' where the key and value are the same.

18+--

19+-- On GHCJS when built with the @fast-weak@ cabal flag, 'FastWeak' is implemented directly

20+-- in JS using @h$FastWeak@ and @h$FastWeakTicket@ which are a nonstandard part of the GHCJS RTS.

821module Reflex.FastWeak

922 ( FastWeakTicket

1023 , FastWeak

@@ -35,29 +48,57 @@ import System.Mem.Weak

3548

3649

3750#ifdef GHCJS_FAST_WEAK

51+-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'

52+-- can be used to get the referred to value without fear of @Nothing,

53+-- and 'getFastWeakTicketWeak' can be used to get the weak version.

54+--

55+-- Implemented by way of special support in the GHCJS RTS, @h$FastWeakTicket@.

3856newtype FastWeakTicket a = FastWeakTicket JSVal

3957

58+-- | A reference to some value which can be garbage collected if there are only

59+-- weak references to the value left.

60+--

61+-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.

62+--

63+-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using

64+-- 'getFastWeakTicket' if the value hasn't been collected yet.

65+--

66+-- Implemented by way of special support in the GHCJS RTS, @h$FastWeak@.

4067newtype FastWeak a = FastWeak JSVal

4168

4269-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two

4370data Val a = Val { unVal :: a }

4471

45−-- | Coerce a JSVal that represents the heap object of a value of type 'a' into a value of type 'a'

72+-- | Coerce a JSVal that represents the heap object of a value of type @a@ into a value of type @a@

4673unsafeFromRawJSVal :: JSVal -> a

4774unsafeFromRawJSVal v = unVal (unsafeCoerce v)

4875

76+-- | Coerce a heap object of type @a@ into a 'JSVal' which represents that object.

4977unsafeToRawJSVal :: a -> JSVal

5078unsafeToRawJSVal v = unsafeCoerce (Val v)

5179#else

80+-- | A 'FastWeak' which has been promoted to a strong reference. 'getFastWeakTicketValue'

81+-- can be used to get the referred to value without fear of @Nothing@,

82+-- and 'getFastWeakTicketWeak' can be used to get the weak version.

5283data FastWeakTicket a = FastWeakTicket

5384 { _fastWeakTicket_val :: !a

5485 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)

5586 }

5687

88+-- | A reference to some value which can be garbage collected if there are only weak references to the value left.

89+--

90+-- 'getFastWeakValue' can be used to try and obtain a strong reference to the value.

91+--

92+-- The value in a @FastWeak@ can also be kept alive by obtaining a 'FastWeakTicket' using 'getFastWeakTicket'

93+-- if the value hasn't been collected yet.

94+--

95+-- Synonymous with 'Weak'.

5796type FastWeak a = Weak a

5897#endif

5998

60−-- This needs to be in IO so we know that we've relinquished the ticket

99+-- | Return the @a@ kept alive by the given 'FastWeakTicket'.

100+--

101+-- This needs to be in IO so we know that we've relinquished the ticket.

61102getFastWeakTicketValue :: FastWeakTicket a -> IO a

62103#ifdef GHCJS_FAST_WEAK

63104getFastWeakTicketValue t = do

@@ -69,6 +110,8 @@ foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a

69110getFastWeakTicketValue = return . _fastWeakTicket_val

70111#endif

71112

113+-- | Get the value referred to by a 'FastWeak' if it hasn't yet been collected,

114+-- or @Nothing@ if it has been collected.

72115getFastWeakValue :: FastWeak a -> IO (Maybe a)

73116#ifdef GHCJS_FAST_WEAK

74117getFastWeakValue w = do

@@ -84,6 +127,9 @@ foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.v

84127getFastWeakValue = deRefWeak

85128#endif

86129

130+-- | Try to create a 'FastWeakTicket' for the given 'FastWeak' which will ensure the value referred

131+-- remains alive. Returns @Just@ if the value hasn't been collected

132+-- and a ticket can therefore be obtained, @Nothing@ if it's been collected.

87133getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))

88134#ifdef GHCJS_FAST_WEAK

89135getFastWeakTicket w = do

@@ -103,8 +149,11 @@ getFastWeakTicket w = do

103149 }

104150#endif

105151

106−-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the associated FastWeak to actually be weak

152+-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process

153+-- which can be obtained with 'getFastWeakTicketValue'.

107154mkFastWeakTicket :: a -> IO (FastWeakTicket a)

155+-- I think it's fine if this is lazy - it'll retain the 'a', but so would the output; we just need to make sure it's forced before we start relying on the

156+-- associated FastWeak to actually be weak

108157#ifdef GHCJS_FAST_WEAK

109158mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)

110159

@@ -119,11 +168,16 @@ mkFastWeakTicket v = do

119168 }

120169#endif

121170

171+-- | Demote a 'FastWeakTicket'; which ensures the value is alive, to a 'FastWeak' which doesn't.

172+-- Note that unless the ticket for the same 'FastWeak' is held in some other way

173+-- the value might be collected immediately.

174+getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

122175-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value

123176#ifdef GHCJS_FAST_WEAK

124−foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

177+foreign import javascript unsafe "$r = $1.weak;" getFastWeakTicketWeak' :: FastWeakTicket a -> IO (FastWeak a)

178+{-# INLINE getFastWeakTicketWeak #-}

179+getFastWeakTicketWeak = getFastWeakTicketWeak'

125180#else

126−getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

127181getFastWeakTicketWeak = return . _fastWeakTicket_weak

128182#endif

129183

src/Reflex/FunctorMaybe.hs+23−21

@@ -1,43 +1,45 @@

1−-- | This module defines the FunctorMaybe class, which extends Functors with the

2−-- ability to delete values.

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE StandaloneDeriving #-}

5+-- |

6+-- Module:

7+-- Reflex.FunctorMaybe

8+-- Description:

9+-- This module defines the FunctorMaybe class, which extends Functors with the

10+-- ability to delete values.

311module Reflex.FunctorMaybe

412 ( FunctorMaybe (..)

513 ) where

614

715import Data.IntMap (IntMap)

8−import qualified Data.IntMap as IntMap

916import Data.Map (Map)

10−import qualified Data.Map as Map

11−import Data.Maybe

17+#if MIN_VERSION_base(4,9,0)

18+import Data.Semigroup (Option(..))

19+#endif

20+import Data.Witherable

1221

1322--TODO: See if there's a better class in the standard libraries already

1423

1524-- | A class for values that combines filtering and mapping using 'Maybe'.

16−-- Morally, @'FunctorMaybe' ~ KleisliFunctor 'Maybe'@. Also similar is the

17−-- @Witherable@ typeclass, but it requires @Foldable f@ and @Traverable f@,

18−-- and e.g. 'Event' is instance of neither.

19−--

20−-- A definition of 'fmapMaybe' must satisfy the following laws:

21−--

22−-- [/identity/]

23−-- @'fmapMaybe' 'Just' ≡ 'id'@

24−--

25−-- [/composition/]

26−-- @'fmapMaybe' (f <=< g) ≡ 'fmapMaybe' f . 'fmapMaybe' g@

25+-- Morally, @'FunctorMaybe' ~ KleisliFunctor 'Maybe'@.

26+{-# DEPRECATED FunctorMaybe "Use 'Filterable' from Data.Witherable instead" #-}

2727class FunctorMaybe f where

2828 -- | Combined mapping and filtering function.

2929 fmapMaybe :: (a -> Maybe b) -> f a -> f b

3030

31−-- | @fmapMaybe = (=<<)

3231instance FunctorMaybe Maybe where

33− fmapMaybe = (=<<)

32+ fmapMaybe = mapMaybe

33+

34+#if MIN_VERSION_base(4,9,0)

35+deriving instance FunctorMaybe Option

36+#endif

3437

35−-- | @fmapMaybe = mapMaybe@

3638instance FunctorMaybe [] where

3739 fmapMaybe = mapMaybe

3840

3941instance FunctorMaybe (Map k) where

40− fmapMaybe = Map.mapMaybe

42+ fmapMaybe = mapMaybe

4143

4244instance FunctorMaybe IntMap where

43− fmapMaybe = IntMap.mapMaybe

45+ fmapMaybe = mapMaybe

src/Reflex/Network.hs+10−4

@@ -3,6 +3,11 @@

33#ifdef USE_REFLEX_OPTIMIZER

44{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}

55#endif

6+-- |

7+-- Module:

8+-- Reflex.Network

9+-- Description:

10+-- This module provides combinators for building FRP graphs/networks and modifying them dynamically.

611module Reflex.Network

712 ( networkView

813 , networkHold

@@ -14,16 +19,17 @@ import Reflex.Adjustable.Class

1419import Reflex.NotReady.Class

1520import Reflex.PostBuild.Class

1621

17−-- | Given a Dynamic of network-creating actions, create a network that is recreated whenever the Dynamic updates.

18−-- The returned Event of network results occurs when the Dynamic does.

19−-- Note: Often, the type 'a' is an Event, in which case the return value is an Event-of-Events that would typically be flattened (via 'switchPromptly').

22+-- | A 'Dynamic' "network": Takes a 'Dynamic' of network-creating actions and replaces the network whenever the 'Dynamic' updates.

23+-- The returned Event of network results fires when the 'Dynamic' updates.

24+-- Note: Often, the type 'a' is an Event, in which case the return value is an Event-of-Events, where the outer 'Event' fires

25+-- when switching networks. Such an 'Event' would typically be flattened (via 'switchPromptly').

2026networkView :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)

2127networkView child = do

2228 postBuild <- getPostBuild

2329 let newChild = leftmost [updated child, tagCheap (current child) postBuild]

2430 snd <$> runWithReplace notReady newChild

2531

26−-- | Given an initial network and an Event of network-creating actions, create a network that is recreated whenever the Event fires.

32+-- | Given an initial "network" and an 'Event' of network-creating actions, create a network that is recreated whenever the Event fires.

2733-- The returned Dynamic of network results occurs when the Event does.

2834-- Note: Often, the type 'a' is an Event, in which case the return value is a Dynamic-of-Events that would typically be flattened.

2935networkHold :: (Adjustable t m, MonadHold t m) => m a -> Event t (m a) -> m (Dynamic t a)

src/Reflex/NotReady/Class.hs+10

@@ -15,7 +15,9 @@ module Reflex.NotReady.Class

1515

1616import Control.Monad.Reader (ReaderT)

1717import Control.Monad.Trans

18+import Control.Monad.Trans.Writer (WriterT)

1819

20+import Reflex.BehaviorWriter.Base (BehaviorWriterT)

1921import Reflex.Class

2022import Reflex.DynamicWriter.Base (DynamicWriterT)

2123import Reflex.EventWriter.Base (EventWriterT)

@@ -39,6 +41,10 @@ instance NotReady t m => NotReady t (ReaderT r m) where

3941 notReadyUntil = lift . notReadyUntil

4042 notReady = lift notReady

4143

44+instance (NotReady t m, Monoid w) => NotReady t (WriterT w m) where

45+ notReadyUntil = lift . notReadyUntil

46+ notReady = lift notReady

47+

4248instance NotReady t m => NotReady t (PostBuildT t m) where

4349 notReadyUntil = lift . notReadyUntil

4450 notReady = lift notReady

@@ -51,6 +57,10 @@ instance NotReady t m => NotReady t (DynamicWriterT t w m) where

5157 notReadyUntil = lift . notReadyUntil

5258 notReady = lift notReady

5359

60+instance NotReady t m => NotReady t (BehaviorWriterT t w m) where

61+ notReadyUntil = lift . notReadyUntil

62+ notReady = lift notReady

63+

5464instance NotReady t m => NotReady t (QueryT t q m) where

5565 notReadyUntil = lift . notReadyUntil

5666 notReady = lift notReady

src/Reflex/Optimizer.hs+8−4

@@ -1,10 +1,14 @@

1−-- | This module provides a GHC plugin designed to improve code that uses

2−-- Reflex. Currently, it just adds an INLINABLE pragma to any top-level

3−-- definition that doesn't have an explicit inlining pragma. In the future,

4−-- additional optimizations are likely to be added.

51{-# LANGUAGE CPP #-}

62{-# LANGUAGE LambdaCase #-}

73{-# LANGUAGE OverloadedStrings #-}

4+-- |

5+-- Module:

6+-- Reflex.Optimizer

7+-- Description:

8+-- This module provides a GHC plugin designed to improve code that uses

9+-- Reflex. Currently, it just adds an INLINABLE pragma to any top-level

10+-- definition that doesn't have an explicit inlining pragma. In the future,

11+-- additional optimizations are likely to be added.

812module Reflex.Optimizer

913 ( plugin

1014 ) where

src/Reflex/Patch.hs+12−5

@@ -1,6 +1,10 @@

1−-- | This module defines the 'Patch' class, which is used by Reflex to manage

2−-- changes to 'Reflex.Class.Incremental' values.

31{-# LANGUAGE TypeFamilies #-}

2+-- |

3+-- Module:

4+-- Reflex.Patch

5+-- Description:

6+-- This module defines the 'Patch' class, which is used by Reflex to manage

7+-- changes to 'Reflex.Class.Incremental' values.

48module Reflex.Patch

59 ( module Reflex.Patch

610 , module X

@@ -17,11 +21,9 @@ import Reflex.Patch.Map as X

1721import Reflex.Patch.MapWithMove as X (PatchMapWithMove, patchMapWithMoveNewElements,

1822 patchMapWithMoveNewElementsMap, unPatchMapWithMove,

1923 unsafePatchMapWithMove)

20−

24+import Data.Map.Monoidal (MonoidalMap)

2125import Data.Semigroup (Semigroup (..), (<>))

2226

23−---- Patches based on commutative groups

24−

2527-- | A 'Group' is a 'Monoid' where every element has an inverse.

2628class (Semigroup q, Monoid q) => Group q where

2729 negateG :: q -> q

@@ -37,3 +39,8 @@ newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }

3739instance Additive p => Patch (AdditivePatch p) where

3840 type PatchTarget (AdditivePatch p) = p

3941 apply (AdditivePatch p) q = Just $ p <> q

42+

43+instance (Ord k, Group q) => Group (MonoidalMap k q) where

44+ negateG = fmap negateG

45+

46+instance (Ord k, Additive q) => Additive (MonoidalMap k q)

src/Reflex/Patch/Class.hs+1−1

@@ -4,7 +4,7 @@ module Reflex.Patch.Class where

55import Control.Monad.Identity

66import Data.Maybe

7−import Data.Semigroup

7+import Data.Semigroup (Semigroup(..))

99-- | A 'Patch' type represents a kind of change made to a datastructure.

1010--

src/Reflex/Patch/DMap.hs+22−8

@@ -5,6 +5,7 @@

55{-# LANGUAGE ScopedTypeVariables #-}

66{-# LANGUAGE StandaloneDeriving #-}

77{-# LANGUAGE TypeFamilies #-}

8+-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.

89module Reflex.Patch.DMap where

910

1011import Reflex.Patch.Class

@@ -20,14 +21,16 @@ import qualified Data.Map as Map

2021import Data.Semigroup (Semigroup (..))

2122import Data.Some (Some)

2223

23−-- | A set of changes to a 'DMap'. Any element may be inserted/updated or

24−-- deleted.

24+-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.

25+-- Insertions are represented as @'ComposeMaybe' (Just value)@,

26+-- while deletions are represented as @'ComposeMaybe' Nothing@.

2527newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }

2628

2729deriving instance GCompare k => Semigroup (PatchDMap k v)

2830

2931deriving instance GCompare k => Monoid (PatchDMap k v)

3032

33+-- | Apply the insertions or deletions to a given 'DMap'.

3134instance GCompare k => Patch (PatchDMap k v) where

3235 type PatchTarget (PatchDMap k v) = DMap k v

3336 apply (PatchDMap diff) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

@@ -37,32 +40,43 @@ instance GCompare k => Patch (PatchDMap k v) where

3740 Nothing -> Just $ Constant ()

3841 Just _ -> Nothing

3942

43+-- | Map a function @v a -> v' a@ over any inserts/updates in the given

44+-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.

4045mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'

4146mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p

4247

43−traversePatchDMap :: Applicative m => (forall a. v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')

48+-- | Map an effectful function @v a -> f (v' a)@ over any inserts/updates in the given

49+-- @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.

50+traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')

4451traversePatchDMap f = traversePatchDMapWithKey $ const f

4552

53+-- | Map an effectful function @k a -> v a -> f (v' a)@ over any inserts/updates

54+-- in the given @'PatchDMap' k v@ to produce a @'PatchDMap' k v'@.

4655traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')

4756traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p

4857

58+-- | Weaken a @'PatchDMap' k v@ to a @'PatchMap' (Some k) v'@ using a function

59+-- @v a -> v'@ to weaken each value contained in the patch.

4960weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'

5061weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p

5162

52−patchDMapToPatchMapWith :: (f v -> v') -> PatchDMap (Const2 k v) f -> PatchMap k v'

63+-- | Convert a weak @'PatchDMap' ('Const2' k a) v@ where the @a@ is known by way of

64+-- the @Const2@ into a @'PatchMap' k v'@ using a rank 1 function @v a -> v'@.

65+patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'

5366patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p

5467

55−const2PatchDMapWith :: forall k v f a. (v -> f a) -> PatchMap k v -> PatchDMap (Const2 k a) f

68+-- | Convert a @'PatchMap' k v@ into a @'PatchDMap' ('Const2' k a) v'@ using a function @v -> v' a@.

69+const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'

5670const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p

57− where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe f)

71+ where g :: (k, Maybe v) -> DSum (Const2 k a) (ComposeMaybe v')

5872 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

5973

74+-- | Convert a @'PatchIntMap' v@ into a @'PatchDMap' ('Const2' Int a) v'@ using a function @v -> v' a@.

6075const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f

6176const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p

6277 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)

6378 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

6479

65−-- | Get the values that will be deleted if the given patch is applied to the

66−-- given 'DMap'. Includes values that will be replaced.

80+-- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.

6781getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'

6882getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p

src/Reflex/Patch/DMapWithMove.hs+3−2

@@ -104,6 +104,7 @@ validationErrorsForPatchDMapWithMove m =

104104 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"

105105 unbalancedMove _ = Nothing

106106

107+-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.

107108instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where

108109 PatchDMapWithMove a == PatchDMapWithMove b = a == b

109110

@@ -341,6 +342,7 @@ const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fr

341342 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni

342343 }

343344

345+-- | Apply the insertions, deletions, and moves to a given 'DMap'.

344346instance GCompare k => Patch (PatchDMapWithMove k v) where

345347 type PatchTarget (PatchDMapWithMove k v) = DMap k v

346348 apply (PatchDMapWithMove p) old = Just $! insertions `DMap.union` (old `DMap.difference` deletions) --TODO: return Nothing sometimes --Note: the strict application here is critical to ensuring that incremental merges don't hold onto all their prerequisite events forever; can we make this more robust?

@@ -356,8 +358,7 @@ instance GCompare k => Patch (PatchDMapWithMove k v) where

356358 From_Delete -> Just $ Constant ()

357359 _ -> Nothing

358360

359−-- | Get the values that will be deleted or moved if the given patch is applied

360−-- to the given 'DMap'.

361+-- | Get the values that will be replaced, deleted, or moved if the given patch is applied to the given 'DMap'.

361362getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))

362363getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p

363364 where f _ v ni = Pair v $ _nodeInfo_to ni

src/Reflex/Patch/IntMap.hs+19−1

@@ -4,6 +4,8 @@

44{-# LANGUAGE DeriveTraversable #-}

55{-# LANGUAGE GeneralizedNewtypeDeriving #-}

66{-# LANGUAGE TypeFamilies #-}

7+-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for

8+-- insert/update or delete of associations.

79module Reflex.Patch.IntMap where

810

911import Data.IntMap.Strict (IntMap)

@@ -12,8 +14,12 @@ import Data.Maybe

1214import Data.Semigroup

1315import Reflex.Patch.Class

1416

17+-- | 'Patch' for 'IntMap' which represents insertion or deletion of keys in the mapping.

18+-- Internally represented by 'IntMap (Maybe a)', where @Just@ means insert/update

19+-- and @Nothing@ means delete.

1520newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)

1621

22+-- | Apply the insertions or deletions to a given 'IntMap'.

1723instance Patch (PatchIntMap a) where

1824 type PatchTarget (PatchIntMap a) = IntMap a

1925 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $

@@ -36,14 +42,26 @@ instance Semigroup (PatchIntMap v) where

3642 GT -> x

3743#endif

3844

39−traverseIntMapPatchWithKey :: Applicative t => (Int -> a -> t b) -> PatchIntMap a -> t (PatchIntMap b)

45+-- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@

46+-- (that is, all inserts/updates), producing a @PatchIntMap b@.

47+mapIntMapPatchWithKey :: (Int -> a -> b) -> PatchIntMap a -> PatchIntMap b

48+mapIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap $ IntMap.mapWithKey (\ k mv -> f k <$> mv) m

49+

50+-- | Map an effectful function @Int -> a -> f b@ over all @a@s in the given @'PatchIntMap' a@

51+-- (that is, all inserts/updates), producing a @f (PatchIntMap b)@.

52+traverseIntMapPatchWithKey :: Applicative f => (Int -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)

4053traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m

4154

55+-- | Extract all @a@s inserted/updated by the given @'PatchIntMap' a@.

4256patchIntMapNewElements :: PatchIntMap a -> [a]

4357patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m

4458

59+-- | Convert the given @'PatchIntMap' a@ into an @'IntMap' a@ with all

60+-- the inserts/updates in the given patch.

4561patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

4662patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m

4763

64+-- | Subset the given @'IntMap' a@ to contain only the keys that would be

65+-- deleted by the given @'PatchIntMap' a@.

4866getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'

4967getDeletions (PatchIntMap m) v = IntMap.intersection v m

src/Reflex/Patch/Map.hs+1−2

@@ -18,8 +18,7 @@ import Data.Semigroup

1818newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }

1919 deriving (Show, Read, Eq, Ord)

2020

21−-- | Applying a 'PatchMap' will update the 'Map' by performing the insertions

22−-- and deletions specified

21+-- | Apply the insertions or deletions to a given 'Map'.

2322instance Ord k => Patch (PatchMap k v) where

2423 type PatchTarget (PatchMap k v) = Map k v

2524 {-# INLINABLE apply #-}

src/Reflex/Patch/MapWithMove.hs+59−17

@@ -20,9 +20,9 @@ import Data.List

2020import Data.Map (Map)

2121import qualified Data.Map as Map

2222import Data.Maybe

23−import Data.Semigroup

23+import Data.Semigroup (Semigroup (..), (<>))

2424import qualified Data.Set as Set

25−import Data.These

25+import Data.These (These(..))

2626import Data.Tuple

2727

2828-- | Patch a DMap with additions, deletions, and moves. Invariant: If key @k1@

@@ -41,6 +41,18 @@ data NodeInfo k v = NodeInfo

4141 }

4242 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

4343

44+-- | Describe how a key's new value should be produced

45+data From k v

46+ = From_Insert v -- ^ Insert the given value here

47+ | From_Delete -- ^ Delete the existing value, if any, from here

48+ | From_Move !k -- ^ Move the value here from the given key

49+ deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

50+

51+-- | Describe where a key's old value will go. If this is 'Just', that means

52+-- the key's old value will be moved to the given other key; if it is 'Nothing',

53+-- that means it will be deleted.

54+type To = Maybe

55+

4456-- | Create a 'PatchMapWithMove', validating it

4557patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)

4658patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing

@@ -62,22 +74,51 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo

6274unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

6375unPatchMapWithMove (PatchMapWithMove p) = p

6476

65−-- | Warning: when using this function, you must ensure that the invariants of

66−-- 'PatchMapWithMove' are preserved; they will not be checked.

67−unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v

68−unsafePatchMapWithMove = PatchMapWithMove

77+-- | Make a @'PatchMapWithMove' k v@ which has the effect of inserting or updating a value @v@ to the given key @k@, like 'Map.insert'.

78+insertMapKey :: k -> v -> PatchMapWithMove k v

79+insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing

6980

70−-- | Describe how a key's new value should be produced

71−data From k v

72− = From_Insert v -- ^ Insert the given value here

73− | From_Delete -- ^ Delete the existing value, if any, from here

74− | From_Move !k -- ^ Move the value here from the given key

75− deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

81+-- |Make a @'PatchMapWithMove' k v@ which has the effect of moving the value from the first key @k@ to the second key @k@, equivalent to:

82+--

83+-- @

84+-- 'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))

85+-- @

86+moveMapKey :: Ord k => k -> k -> PatchMapWithMove k v

87+moveMapKey src dst

88+ | src == dst = mempty

89+ | otherwise =

90+ PatchMapWithMove $ Map.fromList

91+ [ (dst, NodeInfo (From_Move src) Nothing)

92+ , (src, NodeInfo From_Delete (Just dst))

93+ ]

7694

77−-- | Describe where a key's old value will go. If this is 'Just', that means

78−-- the key's old value will be moved to the given other key; if it is 'Nothing',

79−-- that means it will be deleted.

80−type To = Maybe

95+-- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:

96+--

97+-- @

98+-- let aMay = Map.lookup a map

99+-- bMay = Map.lookup b map

100+-- in maybe id (Map.insert a) (bMay `mplus` aMay)

101+-- . maybe id (Map.insert b) (aMay `mplus` bMay)

102+-- . Map.delete a . Map.delete b $ map

103+-- @

104+swapMapKey :: Ord k => k -> k -> PatchMapWithMove k v

105+swapMapKey src dst

106+ | src == dst = mempty

107+ | otherwise =

108+ PatchMapWithMove $ Map.fromList

109+ [ (dst, NodeInfo (From_Move src) (Just src))

110+ , (src, NodeInfo (From_Move dst) (Just dst))

111+ ]

112+

113+-- |Make a @'PatchMapWithMove' k v@ which has the effect of deleting a key in the mapping, equivalent to 'Map.delete'.

114+deleteMapKey :: k -> PatchMapWithMove k v

115+deleteMapKey k = PatchMapWithMove . Map.singleton k $ NodeInfo From_Delete Nothing

116+

117+-- | Wrap a @'Map' k (NodeInfo k v)@ representing patch changes into a @'PatchMapWithMove' k v@, without checking any invariants.

118+--

119+-- __Warning:__ when using this function, you must ensure that the invariants of 'PatchMapWithMove' are preserved; they will not be checked.

120+unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v

121+unsafePatchMapWithMove = PatchMapWithMove

81122

82123-- | Apply the insertions, deletions, and moves to a given 'Map'

83124instance Ord k => Patch (PatchMapWithMove k v) where

@@ -91,10 +132,11 @@ instance Ord k => Patch (PatchMapWithMove k v) where

91132 From_Delete -> Just ()

92133 _ -> Nothing

93134

94−-- | Returns all the new elements that will be added to the 'Map'

135+-- | Returns all the new elements that will be added to the 'Map'.

95136patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]

96137patchMapWithMoveNewElements = Map.elems . patchMapWithMoveNewElementsMap

97138

139+-- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.

98140patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v

99141patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p

100142 where f ni = case _nodeInfo_from ni of

src/Reflex/Profiled.hs+6

@@ -8,6 +8,12 @@

88{-# LANGUAGE StandaloneDeriving #-}

99{-# LANGUAGE TypeFamilies #-}

1010{-# LANGUAGE UndecidableInstances #-}

11+-- |

12+-- Module:

13+-- Reflex.Profiled

14+-- Description:

15+-- This module contains an instance of the 'Reflex' class that provides

16+-- profiling/cost-center information.

1117module Reflex.Profiled where

1218

1319import Control.Lens hiding (children)

src/Reflex/Pure.hs+11−9

@@ -13,11 +13,13 @@

1313-- * MonadSample (Pure t) ((->) t)

1414-- * MonadHold (Pure t) ((->) t)

1515{-# OPTIONS_GHC -fno-warn-orphans #-}

16−

17−-- | This module provides a pure implementation of Reflex, which is intended to

18−-- serve as a reference for the semantics of the Reflex class. All

19−-- implementations of Reflex should produce the same results as this

20−-- implementation, although performance and laziness/strictness may differ.

16+-- |

17+-- Module: Reflex.Pure

18+-- Description:

19+-- This module provides a pure implementation of Reflex, which is intended to

20+-- serve as a reference for the semantics of the Reflex class. All

21+-- implementations of Reflex should produce the same results as this

22+-- implementation, although performance and laziness/strictness may differ.

2123module Reflex.Pure

2224 ( Pure

2325 , Behavior (..)

@@ -43,12 +45,12 @@ import Data.Type.Coercion

4345import Reflex.Class

4446

4547-- | A completely pure-functional 'Reflex' timeline, identifying moments in time

46−-- with the type @t@.

48+-- with the type @/t/@.

4749data Pure t

4850

49−-- | The Enum instance of t must be dense: for all x :: t, there must not exist

50−-- any y :: t such that pred x < y < x. The HasTrie instance will be used

51−-- exclusively to memoize functions of t, not for any of its other capabilities.

51+-- | The 'Enum' instance of @/t/@ must be dense: for all @/x :: t/@, there must not exist

52+-- any @/y :: t/@ such that @/'pred' x < y < x/@. The 'HasTrie' instance will be used

53+-- exclusively to memoize functions of @/t/@, not for any of its other capabilities.

5254instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

5355

5456 newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }

src/Reflex/Query/Base.hs+1−1

@@ -333,5 +333,5 @@ instance Requester t m => Requester t (QueryT t q m) where

333333instance EventWriter t w m => EventWriter t w (QueryT t q m) where

334334 tellEvent = lift . tellEvent

335335

336−instance MonadDynamicWriter t w m => MonadDynamicWriter t w (QueryT t q m) where

336+instance DynamicWriter t w m => DynamicWriter t w (QueryT t q m) where

337337 tellDyn = lift . tellDyn

src/Reflex/Query/Class.hs+1−1

@@ -27,7 +27,7 @@ import Data.Data

2727import Data.Ix

2828import Data.Map.Monoidal (MonoidalMap)

2929import qualified Data.Map.Monoidal as MonoidalMap

30−import Data.Semigroup

30+import Data.Semigroup (Semigroup(..))

3131import Foreign.Storable

3232

3333import Reflex.Class

src/Reflex/Requester/Base.hs+112−3

@@ -21,14 +21,20 @@

2121module Reflex.Requester.Base

2222 ( RequesterT (..)

2323 , runRequesterT

24+ , withRequesterT

2425 , runWithReplaceRequesterTWith

2526 , traverseIntMapWithKeyWithAdjustRequesterTWith

2627 , traverseDMapWithKeyWithAdjustRequesterTWith

2728 , RequesterData

2829 , RequesterDataKey

2930 , traverseRequesterData

31+ , forRequesterData

3032 , requesterDataToList

3133 , singletonRequesterData

34+ , matchResponsesWithRequests

35+ , multiEntry

36+ , unMultiEntry

37+ , requesting'

3238 ) where

3339

3440import Reflex.Class

@@ -43,6 +49,7 @@ import Reflex.TriggerEvent.Class

4349import Control.Applicative (liftA2)

4450import Control.Monad.Exception

4551import Control.Monad.Identity

52+import Control.Monad.Primitive

4653import Control.Monad.Reader

4754import Control.Monad.Ref

4855import Control.Monad.State.Strict

@@ -130,6 +137,10 @@ traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWith

130137 MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request

131138 MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request

132139

140+-- | 'traverseRequesterData' with its arguments flipped

141+forRequesterData :: forall request response m. Applicative m => RequesterData request -> (forall a. request a -> m (response a)) -> m (RequesterData response)

142+forRequesterData r f = traverseRequesterData f r

143+

133144data MyTagType :: * -> * where

134145 MyTagType_Single :: MyTagType (Single a)

135146 MyTagType_Multi :: MyTagType Multi

@@ -239,6 +250,10 @@ deriving instance MonadHold t m => MonadHold t (RequesterT t request response m)

239250deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)

240251deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)

241252

253+instance PrimMonad m => PrimMonad (RequesterT t request response m) where

254+ type PrimState (RequesterT t request response m) = PrimState m

255+ primitive = lift . primitive

256+

242257-- TODO: Monoid and Semigroup can likely be derived once StateT has them.

243258instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where

244259 mempty = pure mempty

@@ -252,7 +267,6 @@ instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response

252267-- requests are made, and responses should be provided in the input 'Event'.

253268-- The 'Tag' keys will be used to return the responses to the same place the

254269-- requests were issued.

255−

256270runRequesterT :: (Reflex t, Monad m)

257271 => RequesterT t request response m a

258272 -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse

@@ -262,6 +276,20 @@ runRequesterT (RequesterT a) responses = do

262276 coerceEvent responses

263277 return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)

264278

279+-- | Map a function over the request and response of a 'RequesterT'

280+withRequesterT

281+ :: (Reflex t, MonadFix m)

282+ => (forall x. req x -> req' x) -- ^ The function to map over the request

283+ -> (forall x. rsp' x -> rsp x) -- ^ The function to map over the response

284+ -> RequesterT t req rsp m a -- ^ The internal 'RequesterT' whose input and output will be transformed

285+ -> RequesterT t req' rsp' m a -- ^ The resulting 'RequesterT'

286+withRequesterT freq frsp child = do

287+ rec let rsp = fmap (runIdentity . traverseRequesterData (Identity . frsp)) rsp'

288+ (a, req) <- lift $ runRequesterT child rsp

289+ rsp' <- fmap (flip selectInt 0 . fanInt . fmapCheap unMultiEntry) $ requesting' $

290+ fmapCheap (multiEntry . IntMap.singleton 0) $ fmap (runIdentity . traverseRequesterData (Identity . freq)) req

291+ return a

292+

265293instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where

266294 type Request (RequesterT t request response m) = request

267295 type Response (RequesterT t request response m) = response

@@ -365,7 +393,7 @@ traverseIntMapWithKeyWithAdjustRequesterTWith base patchNewElements mergePatchIn

365393 pack = Entry

366394 f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')

367395 f' k (n, v) = do

368− (result, myRequests) <- runRequesterT (f k v) $ fmapMaybeCheap (IntMap.lookup n) $ selectInt responses k --TODO: Instead of doing fmapMaybeCheap, can we share a fanInt across all instances of a given key, or at least the ones that are adjacent in time?

396+ (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ selectInt responses k --TODO: Instead of doing mapMaybeCheap, can we share a fanInt across all instances of a given key, or at least the ones that are adjacent in time?

369397 return (fmapCheap (IntMap.singleton n) myRequests, result)

370398 ndm' <- numberOccurrencesFrom 1 dm'

371399 (children0, children') <- base f' (fmap ((,) 0) dm0) $ fmap (\(n, dm) -> fmap ((,) n) dm) ndm' --TODO: Avoid this somehow, probably by adding some sort of per-cohort information passing to Adjustable

@@ -413,7 +441,7 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN

413441 pack = Entry

414442 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)

415443 f' k (Compose (n, v)) = do

416− (result, myRequests) <- runRequesterT (f k v) $ fmapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))

444+ (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))

417445 return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)

418446 ndm' <- numberOccurrencesFrom 1 dm'

419447 (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'

@@ -427,3 +455,84 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN

427455 promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'

428456 requests <- holdIncremental requests0 requests'

429457 return (result0, result')

458+

459+data Decoder rawResponse response =

460+ forall a. Decoder (RequesterDataKey a) (rawResponse -> response a)

461+

462+-- | Matches incoming responses with previously-sent requests

463+-- and uses the provided request "decoder" function to process

464+-- incoming responses.

465+matchResponsesWithRequests

466+ :: forall t rawRequest rawResponse request response m.

467+ ( MonadFix m

468+ , MonadHold t m

469+ , Reflex t

470+ )

471+ => (forall a. request a -> (rawRequest, rawResponse -> response a))

472+ -- ^ Given a request (from 'Requester'), produces the wire format of the

473+ -- request and a function used to process the associated response

474+ -> Event t (RequesterData request)

475+ -- ^ The outgoing requests

476+ -> Event t (Int, rawResponse)

477+ -- ^ The incoming responses, tagged by an identifying key

478+ -> m ( Event t (Map Int rawRequest)

479+ , Event t (RequesterData response)

480+ )

481+ -- ^ A map of outgoing wire-format requests and an event of responses keyed

482+ -- by the 'RequesterData' key of the associated outgoing request

483+matchResponsesWithRequests f send recv = do

484+ rec nextId <- hold 1 $ fmap (\(next, _, _) -> next) outgoing

485+ waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response)) <-

486+ holdIncremental mempty $ leftmost

487+ [ fmap (\(_, outstanding, _) -> outstanding) outgoing

488+ , snd <$> incoming

489+ ]

490+ let outgoing = processOutgoing nextId send

491+ incoming = processIncoming waitingFor recv

492+ return (fmap (\(_, _, rawReqs) -> rawReqs) outgoing, fst <$> incoming)

493+ where

494+ -- Tags each outgoing request with an identifying integer key

495+ -- and returns the next available key, a map of response decoders

496+ -- for requests for which there are outstanding responses, and the

497+ -- raw requests to be sent out.

498+ processOutgoing

499+ :: Behavior t Int

500+ -- The next available key

501+ -> Event t (RequesterData request)

502+ -- The outgoing request

503+ -> Event t ( Int

504+ , PatchMap Int (Decoder rawResponse response)

505+ , Map Int rawRequest )

506+ -- The new next-available-key, a map of requests expecting responses, and the tagged raw requests

507+ processOutgoing nextId out = flip pushAlways out $ \dm -> do

508+ oldNextId <- sample nextId

509+ let (result, newNextId) = flip runState oldNextId $ forM (requesterDataToList dm) $ \(k :=> v) -> do

510+ n <- get

511+ put $ succ n

512+ let (rawReq, rspF) = f v

513+ return (n, rawReq, Decoder k rspF)

514+ patchWaitingFor = PatchMap $ Map.fromList $

515+ (\(n, _, dec) -> (n, Just dec)) <$> result

516+ toSend = Map.fromList $ (\(n, rawReq, _) -> (n, rawReq)) <$> result

517+ return (newNextId, patchWaitingFor, toSend)

518+ -- Looks up the each incoming raw response in a map of response

519+ -- decoders and returns the decoded response and a patch that can

520+ -- be used to clear the ID of the consumed response out of the queue

521+ -- of expected responses.

522+ processIncoming

523+ :: Incremental t (PatchMap Int (Decoder rawResponse response))

524+ -- A map of outstanding expected responses

525+ -> Event t (Int, rawResponse)

526+ -- A incoming response paired with its identifying key

527+ -> Event t (RequesterData response, PatchMap Int v)

528+ -- The decoded response and a patch that clears the outstanding responses queue

529+ processIncoming waitingFor inc = flip push inc $ \(n, rawRsp) -> do

530+ wf <- sample $ currentIncremental waitingFor

531+ case Map.lookup n wf of

532+ Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..

533+ Just (Decoder k rspF) -> do

534+ let rsp = rspF rawRsp

535+ return $ Just

536+ ( singletonRequesterData k rsp

537+ , PatchMap $ Map.singleton n Nothing

538+ )

src/Reflex/Spider.hs+5−2

@@ -1,6 +1,9 @@

11{-# LANGUAGE CPP #-}

2−-- | This module exports all of the user-facing functionality of the 'Spider'

3−-- 'Reflex' engine

2+-- |

3+-- Module:

4+-- Reflex.Spider

5+-- Description:

6+-- This module exports all of the user-facing functionality of the 'Spider' 'Reflex' engine

47module Reflex.Spider

58 ( Spider

69 , SpiderTimeline

src/Reflex/Spider/Internal.hs+5−5

@@ -49,16 +49,16 @@ import Data.GADT.Compare

4949import Data.IntMap.Strict (IntMap)

5050import qualified Data.IntMap.Strict as IntMap

5151import Data.IORef

52−import Data.Maybe

52+import Data.Maybe hiding (mapMaybe)

5353import Data.Monoid ((<>))

5454import Data.Proxy

5555import Data.These

5656import Data.Traversable

57+import Data.Witherable (Filterable, mapMaybe)

5758import GHC.Exts

5859import GHC.IORef (IORef (..))

5960import GHC.Stack

6061import Reflex.FastWeak

61−import Reflex.FunctorMaybe

6262import System.IO.Unsafe

6363import System.Mem.Weak

6464import Unsafe.Coerce

@@ -1128,12 +1128,12 @@ newInvalidatorSwitch subd = return $! InvalidatorSwitch subd

11281128newInvalidatorPull :: Pull x a -> IO (Invalidator x)

11291129newInvalidatorPull p = return $! InvalidatorPull p

11301130

1131−instance HasSpiderTimeline x => FunctorMaybe (Event x) where

1132− fmapMaybe f = push $ return . f

1131+instance HasSpiderTimeline x => Filterable (Event x) where

1132+ mapMaybe f = push $ return . f

11331133

11341134instance HasSpiderTimeline x => Align (Event x) where

11351135 nil = eventNever

1136− align ea eb = fmapMaybe dmapToThese $ merge $ dynamicConst $ DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

1136+ align ea eb = mapMaybe dmapToThese $ merge $ dynamicConst $ DMap.fromDistinctAscList [LeftTag :=> ea, RightTag :=> eb]

11371137

11381138data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)

11391139 | BuildDyn !(EventM x (PatchTarget p), Event x p)

src/Reflex/Time.hs+113−13

@@ -1,5 +1,7 @@

11{-# LANGUAGE CPP #-}

22{-# LANGUAGE DeriveDataTypeable #-}

3+{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE DeriveTraversable #-}

35{-# LANGUAGE FlexibleContexts #-}

46{-# LANGUAGE MultiParamTypeClasses #-}

57{-# LANGUAGE RecursiveDo #-}

@@ -9,6 +11,11 @@

911#ifdef USE_TEMPLATE_HASKELL

1012{-# LANGUAGE TemplateHaskell #-}

1113#endif

14+-- |

15+-- Module:

16+-- Reflex.Time

17+-- Description:

18+-- Clocks, timers, and other time-related functions.

1219module Reflex.Time where

1320

1421import Reflex.Class

@@ -24,46 +31,50 @@ import Control.Monad

2431import Control.Monad.Fix

2532import Control.Monad.IO.Class

2633import Data.Align

34+import Data.Data (Data)

2735import Data.Fixed

36+import Data.Semigroup (Semigroup(..))

2837import Data.Sequence (Seq, (|>))

2938import qualified Data.Sequence as Seq

3039import Data.These

3140import Data.Time.Clock

3241import Data.Typeable

42+import GHC.Generics (Generic)

3343import System.Random

3444

45+-- | Metadata associated with a timer "tick"

3546data TickInfo

3647 = TickInfo { _tickInfo_lastUTC :: UTCTime

3748 -- ^ UTC time immediately after the last tick.

3849 , _tickInfo_n :: Integer

39− -- ^ Number of time periods since t0

50+ -- ^ Number of time periods or ticks since the start of the timer

4051 , _tickInfo_alreadyElapsed :: NominalDiffTime

41− -- ^ Amount of time already elapsed in the current tick period.

52+ -- ^ Amount of time that has elapsed in the current tick period.

4253 }

4354 deriving (Eq, Ord, Show, Typeable)

4455

45−-- | Special case of 'tickLossyFrom' that uses the post-build event to start the

46−-- tick thread.

56+-- | Fires an 'Event' once every time provided interval elapses, approximately.

57+-- The provided 'UTCTime' is used bootstrap the determination of how much time has elapsed with each tick.

58+-- This is a special case of 'tickLossyFrom' that uses the post-build event to start the tick thread.

4759tickLossy :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> UTCTime -> m (Event t TickInfo)

4860tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild

4961

50−-- | Special case of 'tickLossyFrom' that uses the post-build event to start the

51−-- tick thread and the time of the post-build as the tick basis time.

62+-- | Fires an 'Event' once every time provided interval elapses, approximately.

63+-- This is a special case of 'tickLossyFrom' that uses the post-build event to start the tick thread and the time of the post-build as the tick basis time.

5264tickLossyFromPostBuildTime :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> m (Event t TickInfo)

5365tickLossyFromPostBuildTime dt = do

5466 postBuild <- getPostBuild

5567 postBuildTime <- performEvent $ liftIO getCurrentTime <$ postBuild

5668 tickLossyFrom' $ (dt,) <$> postBuildTime

5769

58−-- | Send events over time with the given basis time and interval

59−-- If the system starts running behind, occurrences will be dropped rather than buffered

60−-- Each occurrence of the resulting event will contain the index of the current interval, with 0 representing the basis time

70+-- | Fires an 'Event' approximately each time the provided interval elapses. If the system starts running behind, occurrences will be dropped rather than buffered.

71+-- Each occurrence of the resulting event will contain the index of the current interval, with 0 representing the provided initial time.

6172tickLossyFrom

6273 :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)

6374 => NominalDiffTime

6475 -- ^ The length of a tick interval

6576 -> UTCTime

66− -- ^ The basis time from which intervals count

77+ -- ^ The basis time from which intervals count and with which the initial calculation of elapsed time will be made.

6778 -> Event t a

6879 -- ^ Event that starts a tick generation thread. Usually you want this to

6980 -- be something like the result of getPostBuild that only fires once. But

@@ -71,12 +82,12 @@ tickLossyFrom

7182 -> m (Event t TickInfo)

7283tickLossyFrom dt t0 e = tickLossyFrom' $ (dt, t0) <$ e

7384

74−-- | Generalization of tickLossyFrom that takes dt and t0 in the event.

85+-- | Generalization of tickLossyFrom that takes the delay and initial time as an 'Event'.

7586tickLossyFrom'

7687 :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)

7788 => Event t (NominalDiffTime, UTCTime)

7889 -- ^ Event that starts a tick generation thread. Usually you want this to

79− -- be something like the result of getPostBuild that only fires once. But

90+ -- be something like the result of 'getPostBuild' that only fires once. But

8091 -- there could be uses for starting multiple timer threads.

8192 -> m (Event t TickInfo)

8293tickLossyFrom' e = do

@@ -87,12 +98,16 @@ tickLossyFrom' e = do

8798 Concurrent.delay $ ceiling $ (fst pair - _tickInfo_alreadyElapsed tick) * 1000000

8899 cb (tick, pair)

89100

101+-- | Like 'tickLossy', but immediately calculates the first tick and provides a 'Dynamic' that is updated as ticks fire.

90102clockLossy :: (MonadIO m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), PostBuild t m, MonadHold t m, MonadFix m) => NominalDiffTime -> UTCTime -> m (Dynamic t TickInfo)

91103clockLossy dt t0 = do

92104 initial <- liftIO $ getCurrentTick dt t0

93105 e <- tickLossy dt t0

94106 holdDyn initial e

95107

108+-- | Generates a 'TickInfo', given the specified interval and timestamp. The 'TickInfo' will include the

109+-- current time, the number of ticks that have elapsed since the timestamp, and the amount of time that

110+-- has elapsed since the start time of this tick.

96111getCurrentTick :: NominalDiffTime -> UTCTime -> IO TickInfo

97112getCurrentTick dt t0 = do

98113 t <- getCurrentTime

@@ -266,6 +281,92 @@ throttle t e = do

266281 delayed <- delay t outE

267282 return outE

268283

284+data ThrottleState b

285+ = ThrottleState_Immediate

286+ | ThrottleState_Buffered (ThrottleBuffer b)

287+ deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic, Data, Typeable)

288+

289+data ThrottleBuffer b

290+ = ThrottleBuffer_Empty -- Empty conflicts with lens, and hiding it would require turning

291+ -- on PatternSynonyms

292+ | ThrottleBuffer_Full b

293+ deriving (Eq, Ord, Show, Functor, Foldable, Traversable, Generic, Data, Typeable)

294+

295+instance Semigroup b => Semigroup (ThrottleBuffer b) where

296+ x <> y = case x of

297+ ThrottleBuffer_Empty -> y

298+ ThrottleBuffer_Full b1 -> case y of

299+ ThrottleBuffer_Empty -> x

300+ ThrottleBuffer_Full b2 -> ThrottleBuffer_Full $ b1 <> b2

301+ {-# INLINE (<>) #-}

302+

303+instance Semigroup b => Monoid (ThrottleBuffer b) where

304+ mempty = ThrottleBuffer_Empty

305+ {-# INLINE mempty #-}

306+ mappend = (<>)

307+ {-# INLINE mappend #-}

308+

309+-- | Throttle an input event, ensuring that the output event doesn't occur more often than you are ready for it. If the input event occurs too

310+-- frequently, the output event will contain semigroup-based summaries of the input firings that happened since the last output firing.

311+-- If the output event has not occurred recently, occurrences of the input event will cause the output event to fire immediately.

312+-- The first parameter is a function that receives access to the output event, and should construct an event that fires when the receiver is

313+-- ready for more input. For example, using @delay 20@ would give a simple time-based throttle.

314+--

315+-- NB: The provided lag function must *actually* delay the event.

316+throttleBatchWithLag :: (MonadFix m, MonadHold t m, PerformEvent t m, Semigroup a) => (Event t () -> m (Event t ())) -> Event t a -> m (Event t a)

317+-- Invariants:

318+-- * Immediate mode must turn off whenever output is produced.

319+-- * Output must be produced whenever immediate mode turns from on to off.

320+-- * Immediate mode can only go from off to on when the delayed event fires.

321+-- * Every input firing must go into either an immediate output firing or the

322+-- buffer, but not both.

323+-- * An existing full buffer must either stay in the buffer or go to output,

324+-- but not both.

325+throttleBatchWithLag lag e = do

326+ let f state x = case x of -- (Just $ newState, out)

327+ This a -> -- If only the input event fires

328+ case state of

329+ ThrottleState_Immediate -> -- and we're in immediate mode

330+ -- Immediate mode turns off, and the buffer is empty.

331+ -- We fire the output event with the input event value immediately.

332+ (Just $ ThrottleState_Buffered $ ThrottleBuffer_Empty, Just a)

333+ ThrottleState_Buffered b -> -- and we're not in immediate mode

334+ -- Immediate mode remains off, and we accumulate the input value.

335+ -- We don't fire the output event.

336+ (Just $ ThrottleState_Buffered $ b <> ThrottleBuffer_Full a, Nothing)

337+ That _ -> -- If only the delayed output event fires,

338+ case state of

339+ ThrottleState_Immediate -> -- and we're in immediate mode

340+ -- Nothing happens.

341+ (Nothing, Nothing)

342+ ThrottleState_Buffered ThrottleBuffer_Empty -> -- and the buffer is empty:

343+ -- Immediate mode turns back on, and the buffer remains empty.

344+ -- We don't fire.

345+ (Just ThrottleState_Immediate, Nothing)

346+ ThrottleState_Buffered (ThrottleBuffer_Full b) -> -- and the buffer is full:

347+ -- Immediate mode remains off, and the buffer is cleared.

348+ -- We fire with the buffered value.

349+ (Just $ ThrottleState_Buffered ThrottleBuffer_Empty, Just b)

350+ These a _ -> -- If both the input and delayed output event fire simultaneously:

351+ case state of

352+ ThrottleState_Immediate -> -- and we're in immediate mode

353+ -- Immediate mode turns off, and the buffer is empty.

354+ -- We fire with the input event's value, as it is the most recent we have seen at this moment.

355+ (Just $ ThrottleState_Buffered ThrottleBuffer_Empty, Just a)

356+ ThrottleState_Buffered ThrottleBuffer_Empty -> -- and the buffer is empty:

357+ -- Immediate mode stays off, and the buffer remains empty.

358+ -- We fire with the input event's value.

359+ (Just $ ThrottleState_Buffered ThrottleBuffer_Empty, Just a)

360+ ThrottleState_Buffered (ThrottleBuffer_Full b) -> -- and the buffer is full:

361+ -- Immediate mode remains off, and the buffer is cleared.

362+ -- We fire with everything including the buffered value.

363+ (Just $ ThrottleState_Buffered ThrottleBuffer_Empty, Just (b <> a))

364+ rec (_stateDyn, outE) <- mapAccumMaybeDyn f

365+ ThrottleState_Immediate -- We start in immediate mode with an empty buffer.

366+ (align e delayed)

367+ delayed <- lag (void outE)

368+ return outE

369+

269370#ifdef USE_TEMPLATE_HASKELL

270371makeLensesWith (lensRules & simpleLenses .~ True) ''TickInfo

271372#else

@@ -281,4 +382,3 @@ tickInfo_alreadyElapsed :: Lens' TickInfo NominalDiffTime

281382tickInfo_alreadyElapsed f (TickInfo x1 x2 x3) = (\y -> TickInfo x1 x2 y) <$> f x3

282383{-# INLINE tickInfo_alreadyElapsed #-}

283384#endif

284−

src/Reflex/Workflow.hs+13−1

@@ -1,7 +1,13 @@

11{-# LANGUAGE RecursiveDo #-}

22{-# LANGUAGE ScopedTypeVariables #-}

3+-- |

4+-- Module:

5+-- Reflex.Workflow

6+-- Description:

7+-- Provides a convenient way to describe a series of interrelated widgets that

8+-- can send data to, invoke, and replace one another. Useful for modeling user interface

9+-- "workflows."

310module Reflex.Workflow (

4− -- * Workflows

511 Workflow (..)

612 , workflow

713 , workflowView

@@ -18,21 +24,27 @@ import Reflex.Network

1824import Reflex.NotReady.Class

1925import Reflex.PostBuild.Class

2026

27+-- | A widget in a workflow

28+-- When the 'Event' returned by a 'Workflow' fires, the current 'Workflow' is replaced by the one inside the firing 'Event'. A series of 'Workflow's must share the same return type.

2129newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }

2230

31+-- | Runs a 'Workflow' and returns the 'Dynamic' result of the 'Workflow' (i.e., a 'Dynamic' of the value produced by the current 'Workflow' node, and whose update 'Event' fires whenever one 'Workflow' is replaced by another).

2332workflow :: forall t m a. (Reflex t, Adjustable t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)

2433workflow w0 = do

2534 rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult

2635 return $ fmap fst eResult

2736

37+-- | Similar to 'workflow', but outputs an 'Event' that fires whenever the current 'Workflow' is replaced by the next 'Workflow'.

2838workflowView :: forall t m a. (Reflex t, NotReady t m, Adjustable t m, MonadFix m, MonadHold t m, PostBuild t m) => Workflow t m a -> m (Event t a)

2939workflowView w0 = do

3040 rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace

3141 eReplace <- fmap switch $ hold never $ fmap snd eResult

3242 return $ fmap fst eResult

3343

44+-- | Map a function over a 'Workflow', possibly changing the resturn type.

3445mapWorkflow :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

3546mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)

3647

48+-- | Map a "cheap" function over a 'Workflow'. Refer to the documentation for 'pushCheap' for more information and performance considerations.

3749mapWorkflowCheap :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

3850mapWorkflowCheap f (Workflow x) = Workflow (fmap (f *** fmapCheap (mapWorkflowCheap f)) x)

test/RequesterT.hs+11−9

@@ -1,3 +1,4 @@

1+{-# LANGUAGE BangPatterns #-}

12{-# LANGUAGE FlexibleContexts #-}

23{-# LANGUAGE GADTs #-}

34{-# LANGUAGE RankNTypes #-}

@@ -20,18 +21,19 @@ data RequestInt a where

2021

2122main :: IO ()

2223main = do

23− os1@[[Just [10,9,8,7,6,5,4,3,2,1]]] <- runApp' (unwrapApp testOrdering) $

24+ os1 <- runApp' (unwrapApp testOrdering) $

2425 [ Just ()

2526 ]

2627 print os1

27− os2@[[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]]

28− <- runApp' (unwrapApp testSimultaneous) $ map Just $

29− [ This ()

30− , That ()

31− , This ()

32− , These () ()

33− ]

28+ let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1

29+ os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $

30+ [ This ()

31+ , That ()

32+ , This ()

33+ , These () ()

34+ ]

3435 print os2

36+ let ![[Just [1,3,5,7,9]],[Nothing,Nothing],[Just [2,4,6,8,10]],[Just [2,4,6,8,10],Nothing]] = os2

3537 return ()

3638

3739unwrapRequest :: DSum tag RequestInt -> Int

@@ -43,7 +45,7 @@ unwrapApp :: ( Reflex t, Monad m )

4345 -> m (Event t [Int])

4446unwrapApp x appIn = do

4547 ((), e) <- runRequesterT (x appIn) never

46− return $ fmap (map unwrapRequest . DMap.toList) e

48+ return $ fmap (map unwrapRequest . requesterDataToList) e

4749

4850testOrdering :: ( Response m ~ Identity

4951 , Request m ~ RequestInt