da669e3 · patch · git.iko.soy

git.iko.soy/patch

on develop help sign in

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

da669e3Ali Abrar8 years ago

ChangeLog.mdnew file+10

compare with develop

unifiedsplit

@@ -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

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

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

59[ ] 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)

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

63-- Efficient one-to-many fanout

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

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

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

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

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

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

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

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

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

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

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

71[ ] 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/)

2### Practical Functional Reactive Programming

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

6[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−

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

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

12−### Additional resources

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

11+

12+### Resources

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

15[/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)

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

19[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 @@

6, template-haskell , these, time, transformers

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

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

9−, monoidal-containers

9+, monoidal-containers, witherable

10, useTemplateHaskell ? true

11}:

12mkDerivation {

13 pname = "reflex";

14− version = "0.5";

14+ version = "0.5.0.1";

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

16 libraryHaskellDepends = [

17 base bifunctors containers dependent-map dependent-sum

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

21 transformers-compat prim-uniq

22 base bifunctors containers deepseq dependent-map dependent-sum

23 mtl ref-tf split transformers data-default

24− random time unbounded-delays monoidal-containers

24+ random time unbounded-delays monoidal-containers witherable

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

26 ghcjs-base

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

reflex.cabal+12−5

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

1Name: reflex

2−Version: 0.5

2+Version: 0.6

3Synopsis: Higher-order Functional Reactive Programming

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

5License: BSD3

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

12Cabal-version: >=1.9.2

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

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

15+extra-source-files:

16+ README.md

17+ Quickref.md

18+ ChangeLog.md

16flag use-reflex-optimizer

20flag use-reflex-optimizer

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

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

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

37 hs-source-dirs: src

41 hs-source-dirs: src

38 build-depends:

42 build-depends:

39 MemoTrie == 0.6.*,

43 MemoTrie == 0.6.*,

40− base >= 4.7 && < 4.13,

44+ base >= 4.9 && < 4.13,

41 bifunctors >= 5.2 && < 5.6,

45 bifunctors >= 5.2 && < 5.6,

42 comonad,

46 comonad,

43 containers >= 0.5 && < 0.7,

47 containers >= 0.5 && < 0.7,

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

57 semigroups >= 0.16 && < 0.19,

61 semigroups >= 0.16 && < 0.19,

58 stm >= 2.4 && < 2.6,

62 stm >= 2.4 && < 2.6,

59 syb >= 0.5 && < 0.8,

63 syb >= 0.5 && < 0.8,

60− these >= 0.4 && < 0.8,

64+ these >= 0.4 && < 0.7.7,

61 time >= 1.4 && < 1.9,

65 time >= 1.4 && < 1.9,

62 transformers >= 0.2,

66 transformers >= 0.2,

63 transformers-compat >= 0.3,

67 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

66 exposed-modules:

71 exposed-modules:

67 Data.AppendMap,

72 Data.AppendMap,

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

230 main-is: RequesterT.hs

235 main-is: RequesterT.hs

231 hs-source-dirs: test

236 hs-source-dirs: test

232 build-depends: base

237 build-depends: base

238+ , containers

239+ , deepseq >= 1.3 && < 1.5

233 , dependent-sum

240 , dependent-sum

234 , dependent-map

241 , dependent-map

235 , lens

242 , lens

243+ , mtl

236 , these

244 , these

237 , transformers

245 , transformers

238 , reflex

246 , reflex

239 , ref-tf

247 , ref-tf

240− buildable: False

241 other-modules:

248 other-modules:

242 Reflex.TestPlan

249 Reflex.TestPlan

243 Reflex.Plan.Pure

250 Reflex.Plan.Pure

src/Data/AppendMap.hs+6−16

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

1{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveFunctor #-}

3−{-# LANGUAGE DeriveGeneric #-}

4−{-# LANGUAGE DeriveTraversable #-}

5{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

6{-# LANGUAGE FlexibleInstances #-}

3{-# LANGUAGE FlexibleInstances #-}

7−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8{-# LANGUAGE MultiParamTypeClasses #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE PatternSynonyms #-}

5{-# LANGUAGE PatternSynonyms #-}

10{-# LANGUAGE RoleAnnotations #-}

6{-# LANGUAGE RoleAnnotations #-}

11{-# LANGUAGE ScopedTypeVariables #-}

7{-# LANGUAGE ScopedTypeVariables #-}

12−{-# LANGUAGE StandaloneDeriving #-}

13{-# LANGUAGE TypeFamilies #-}

8{-# LANGUAGE TypeFamilies #-}

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

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

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

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

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

31#else

26#else

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

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

33#endif

28#endif

34−import Data.Map.Monoidal

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

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

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

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

31+import qualified Data.Map.Monoidal as M

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

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

39type AppendMap = MonoidalMap

34type AppendMap = MonoidalMap

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

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

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

46pattern AppendMap m = MonoidalMap m

41pattern AppendMap m = MonoidalMap m

48−instance FunctorMaybe (MonoidalMap k) where

43+instance Filterable (MonoidalMap k) where

49− fmapMaybe = mapMaybe

44+ mapMaybe = M.mapMaybe

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

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

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

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

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

60 -> MonoidalMap token a

55 -> MonoidalMap token a

61 -> Maybe (MonoidalMap token b)

56 -> Maybe (MonoidalMap token b)

62mapMaybeNoNull f as =

57mapMaybeNoNull f as =

63− let bs = fmapMaybe f as

58+ let bs = mapMaybe f as

64 in if null bs

59 in if null bs

65 then Nothing

60 then Nothing

66 else Just bs

61 else Just bs

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

63-- 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−

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

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

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

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

src/Data/FastWeakBag.hs+2−2

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

42import System.Mem.Weak

43#endif

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

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@s remain

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

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

48#ifdef GHCJS_FAST_WEAK

49newtype FastWeakBag a = FastWeakBag JSVal

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

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

38 , dmapToThese

39 , eitherToDSum

40 , dsumToEither

41− -- * Deprecated functions

42− , sequenceDmap

43− , wrapDMap

44− , rewrapDMap

45− , unwrapDMap

46− , unwrapDMapMaybe

47− , extractFunctorDMap

48 , ComposeMaybe (..)

41 , ComposeMaybe (..)

49 ) where

42 ) where

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

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

52import Control.Monad.Identity

45import Control.Monad.Identity

53import Data.Dependent.Map (DMap)

46import Data.Dependent.Map (DMap)

54import qualified Data.Dependent.Map as DMap

47import qualified Data.Dependent.Map as DMap

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

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

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

250

243

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

244deriving 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 @@

1{-# LANGUAGE LambdaCase #-}

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

2module Data.Map.Misc

3module Data.Map.Misc

3 (

4 (

4 -- * Working with Maps

5 -- * Working with Maps

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

10 ) where

11 ) where

12import Data.Align

13import Data.Align

13−import Data.Either (isLeft)

14import Data.Map (Map)

15import qualified Data.Map as Map

16import Data.Maybe

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

18import qualified Data.Set as Set

19import Data.These

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.

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

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

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

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

23 This _ -> Just Nothing

27 This _ -> Just Nothing

24 These _ new -> Just $ Just new

28 These _ new -> Just $ Just new

25 That new -> Just $ Just new

29 That new -> Just $ Just new

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@.

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

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

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

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

29 This _ -> Just Nothing

38 This _ -> Just Nothing

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

32 | otherwise -> Just $ Just new

41 | otherwise -> Just $ Just new

33 That new -> Just $ Just new

42 That new -> Just $ Just new

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'.

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

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

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

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

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

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

38 maybeToEither = \case

50 maybeToEither = \case

39 Nothing -> Left ()

51 Nothing -> Left ()

40 Just r -> Right r

52 Just r -> Right r

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" #-}

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

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

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

57+mapPartitionEithers = Map.mapEither id

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"

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

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+-- @

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

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

65+-- @

66+--

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

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

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

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

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

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

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

src/Data/WeakBag.hs+2−2

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

31import Data.IORef

32import System.Mem.Weak

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

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@s remain

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

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

37data WeakBag a = WeakBag

38 { _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

19import Reflex.Dynamic.Uniq as X

20import Reflex.DynamicWriter.Base as X

21import Reflex.DynamicWriter.Class as X

22+import Reflex.NotReady.Class as X

22import Reflex.PerformEvent.Base as X

23import Reflex.PerformEvent.Base as X

23import Reflex.PerformEvent.Class as X

24import Reflex.PerformEvent.Class as X

24import Reflex.PostBuild.Base as X

25import Reflex.PostBuild.Base as X

src/Reflex/Class.hs+231−92

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

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

22#endif

24+-- |

25+-- Module:

26+-- Reflex.Class

27+-- Description:

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

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

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

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

26−-- signals.

30+-- signals.

27module Reflex.Class

31module Reflex.Class

28 ( module Reflex.Patch

32 ( module Reflex.Patch

29 -- * Primitives

33 -- * Primitives

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

34 , coerceDynamic

38 , coerceDynamic

35 , MonadSample (..)

39 , MonadSample (..)

36 , MonadHold (..)

40 , MonadHold (..)

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

41+ -- ** 'fan' related types

38 , EventSelector (..)

42 , EventSelector (..)

39 , EventSelectorInt (..)

43 , EventSelectorInt (..)

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

41 -- * Convenience functions

44 -- * Convenience functions

42 , constDyn

45 , constDyn

43 , pushAlways

46 , pushAlways

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

134 -- * Unsafe functions

137 -- * Unsafe functions

135 , unsafeDynamic

138 , unsafeDynamic

136 , unsafeMapIncremental

139 , unsafeMapIncremental

137− -- * 'FunctorMaybe'

140+ -- * 'Filterable' convenience functions

138− , FunctorMaybe (..)

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

139 , fforMaybe

144 , fforMaybe

140 , ffilter

145 , ffilter

141 , filterLeft

146 , filterLeft

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

145 , ffor2

150 , ffor2

146 , ffor3

151 , ffor3

147 -- * Deprecated functions

152 -- * Deprecated functions

148− , appendEvents

153+ , switchPromptly

149− , onceE

154+ , switchPromptOnly

150− , sequenceThese

155+ -- * "Cheap" functions

151 , fmapMaybeCheap

156 , fmapMaybeCheap

157+ , mapMaybeCheap

152 , fmapCheap

158 , fmapCheap

153 , fforCheap

159 , fforCheap

154 , fforMaybeCheap

160 , fforMaybeCheap

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

156 , tagCheap

162 , tagCheap

157 , mergeWithCheap

163 , mergeWithCheap

158 , mergeWithCheap'

164 , mergeWithCheap'

159− , switchPromptly

160− , switchPromptOnly

161 -- * Slow, but general, implementations

165 -- * Slow, but general, implementations

162 , slowHeadE

166 , slowHeadE

163 ) where

167 ) where

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

194import Data.String

198import Data.String

195import Data.These

199import Data.These

196import Data.Type.Coercion

200import Data.Type.Coercion

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

202+import qualified Data.Witherable as W

203+import Reflex.FunctorMaybe (FunctorMaybe)

197−import Reflex.FunctorMaybe

204+import qualified Reflex.FunctorMaybe

198import Reflex.Patch

205import Reflex.Patch

199import qualified Reflex.Patch.MapWithMove as PatchMapWithMove

206import qualified Reflex.Patch.MapWithMove as PatchMapWithMove

200

207

201import Debug.Trace (trace)

208import Debug.Trace (trace)

202

209

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

210-- | 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

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

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

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

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

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

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

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

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

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

258 -- 'Event' occurs

265 -- 'Event' occurs

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

275 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

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

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

272 -- that value.

278 -- that value.

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

279 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

310coerceDynamic = coerceWith $ dynamicCoercion Coercion

316coerceDynamic = coerceWith $ dynamicCoercion Coercion

311

317

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

318-- | 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

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

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

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

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

316-- nondeterministically.

322-- nondeterministically.

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

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

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

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

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

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

346 -- 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

342 -- one.

348 -- one.

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

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

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

350 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

389 return $ case result of

395 return $ case result of

390 (Nothing, Nothing) -> Nothing

396 (Nothing, Nothing) -> Nothing

391 _ -> Just result

397 _ -> Just result

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

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

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

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

394

400

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

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

396slowHeadE e = do

402slowHeadE e = do

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

400

406

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

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

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

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

403−-- 'fmapMaybe'.

409+-- 'mapMaybe'.

404newtype EventSelector t k = EventSelector

410newtype EventSelector t k = EventSelector

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

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

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

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

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

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

408 --

414 --

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

415 -- 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

411 -- occurrences of an 'Event'.

417 -- occurrences of an 'Event'.

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

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

413 }

419 }

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

542 negate = fmap negate

548 negate = fmap negate

543 signum = fmap signum

549 signum = fmap signum

544

550

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+

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

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

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

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

547 sconcat = pull . fmap sconcat . mapM sample

562 sconcat = pull . fmap sconcat . mapM sample

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

551 times1p n = fmap $ times1p n

566 times1p n = fmap $ times1p n

552#endif

567#endif

553

568

569+-- | Alias for 'mapMaybe'

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

571+fmapMaybe = mapMaybe

572+

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

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

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

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

556−fforMaybe = flip fmapMaybe

575+fforMaybe = flip mapMaybe

557

576

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

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

559−-- Relies on 'fforMaybe'.

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

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

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

579+ffilter = W.filter

562

580

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

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

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

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

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

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

566

584

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

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

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

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

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

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

570

588

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

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

572-- occurrence).

590-- occurrence).

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

584

602

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

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

586 {-# INLINE fmap #-}

604 {-# INLINE fmap #-}

587− fmap f = fmapMaybe $ Just . f

605+ fmap f = mapMaybe $ Just . f

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

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

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

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

590

608

609+-- TODO Remove this instance

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

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

592 {-# INLINE fmapMaybe #-}

611 {-# INLINE fmapMaybe #-}

612+ fmapMaybe = mapMaybe

613+

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

615+ {-# INLINE mapMaybe #-}

593− fmapMaybe f = push $ return . f

616+ mapMaybe f = push $ return . f

594

617

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

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

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

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

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

641-- event returns 'True'.

664-- event returns 'True'.

642--

665--

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

666-- 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,

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

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

646-- been encountered later.

669-- been encountered later.

647takeWhileE

670takeWhileE

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

656-- event returns 'Just b'.

679-- event returns 'Just b'.

657--

680--

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

681-- 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,

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

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

661-- been encountered later.

684-- been encountered later.

662takeWhileJustE

685takeWhileJustE

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

808fanEither e =

831fanEither e =

809 let justLeft = either Just (const Nothing)

832 let justLeft = either Just (const Nothing)

810 justRight = either (const Nothing) Just

833 justRight = either (const Nothing) Just

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

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

812

835

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

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

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

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

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

820 that (That y) = Just y

843 that (That y) = Just y

821 that (These _ y) = Just y

844 that (These _ y) = Just y

822 that _ = Nothing

845 that _ = Nothing

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

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

824

847

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

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

826-- the individual 'Event's.

849-- the individual 'Event's.

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

829

852

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

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

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

854-- 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.

833--

856--

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

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

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

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

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

875 Nothing -> fmapCheap (const Nothing) e

898 Nothing -> fmapCheap (const Nothing) e

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

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

877

900

878−-- | See 'coincicencePatchMap'

901+-- | See 'coincidencePatchMap'

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

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

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

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

881 Nothing -> fmapCheap (const Nothing) e

904 Nothing -> fmapCheap (const Nothing) e

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

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

883

906

884−-- | See 'coincicencePatchMap'

907+-- | See 'coincidencePatchMap'

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

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

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

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

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

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

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

942

965

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

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

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

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

945−-- More efficient than liftA2.

968+-- More efficient than 'liftA2'.

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

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

947zipDynWith f da db =

970zipDynWith f da db =

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

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

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

973

996

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

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

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

998-- '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.

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

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

978distributeDMapOverDynPure dm = case DMap.toList dm of

1001distributeDMapOverDynPure dm = case DMap.toList dm of

979 [] -> constDyn DMap.empty

1002 [] -> constDyn DMap.empty

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

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

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

1000difference = alignEventWithMaybe $ \case

1023difference = alignEventWithMaybe $ \case

1001 This a -> Just a

1024 This a -> Just a

1002− _ -> Nothing

1025+ _ -> Nothing

1003

1026

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

1028+-- 'Nothing' values are dropped.

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

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

1005−alignEventWithMaybe f ea eb =

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

1006− fmapMaybe (f <=< dmapToThese)

1007− $ merge

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

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

1009

1032

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

1034+-- matches the provided key.

1010filterEventKey

1035filterEventKey

1011 :: forall t m k v a.

1036 :: forall t m k v a.

1012 ( Reflex t

1037 ( Reflex t

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

1024 Nothing -> Nothing

1049 Nothing -> Nothing

1025 takeWhileJustE f kv'

1050 takeWhileJustE f kv'

1026

1051

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.

1028factorEvent

1056factorEvent

1029 :: forall t m k v a.

1057 :: forall t m k v a.

1030 ( Reflex t

1058 ( Reflex t

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

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

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

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

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

1076

1104

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

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

1107+accumDyn

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

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

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

1110+ -> a

1111+ -> Event t b

1112+ -> m (Dynamic t a)

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

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

1114+

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

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

1117+accumMDyn

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

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)

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

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

1124+

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

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

1127+accumMaybeDyn

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

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

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

1130+ -> a

1131+ -> Event t b

1132+ -> m (Dynamic t a)

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

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

1134+

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

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

1137+accumMaybeMDyn

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

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)

1084accumMaybeMDyn f z e = do

1143accumMaybeMDyn f z e = do

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

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

1086 v <- sample $ current d'

1145 v <- sample $ current d'

1087 f v o

1146 f v o

1088 d' <- holdDyn z e'

1147 d' <- holdDyn z e'

1089 return d'

1148 return d'

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

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

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)

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

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

1160+

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

1162+-- 'PushM' action.

1163+mapAccumMDyn

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)

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)

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

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

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

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)

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)

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

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

1184+

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

1186+-- 'PushM' action.

1187+mapAccumMaybeMDyn

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)

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)

1097mapAccumMaybeMDyn f z e = do

1193mapAccumMaybeMDyn f z e = do

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

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

1099 v <- sample $ current d'

1195 v <- sample $ current d'

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

1101 return $ case result of

1197 return $ case result of

1102 (Nothing, Nothing) -> Nothing

1198 (Nothing, Nothing) -> Nothing

1103 _ -> Just result

1199 _ -> Just result

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

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

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

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

1106

1202

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

1204+-- with the provided function.

1107{-# INLINE accumB #-}

1205{-# INLINE accumB #-}

1206+accumB

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

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

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

1209+ -> a

1210+ -> Event t b

1211+ -> m (Behavior t a)

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

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

1213+

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

1110{-# INLINE accumMB #-}

1215{-# INLINE accumMB #-}

1216+accumMB

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

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)

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

1222accumMB 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.

1113{-# INLINE accumMaybeB #-}

1226{-# INLINE accumMaybeB #-}

1227+accumMaybeB

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

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

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

1230+ -> a

1231+ -> Event t b

1232+ -> m (Behavior t a)

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

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

1234+

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

1116{-# INLINE accumMaybeMB #-}

1236{-# INLINE accumMaybeMB #-}

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

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

1118accumMaybeMB f z e = do

1238accumMaybeMB f z e = do

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

1121 f v o

1241 f v o

1122 d' <- hold z e'

1242 d' <- hold z e'

1123 return d'

1243 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'.

1124{-# INLINE mapAccumB #-}

1248{-# INLINE mapAccumB #-}

1249+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)

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)

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

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

1256+

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

1127{-# INLINE mapAccumMB #-}

1258{-# INLINE mapAccumMB #-}

1259+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)

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)

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

1265mapAccumMB 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.

1130{-# INLINE mapAccumMaybeB #-}

1270{-# INLINE mapAccumMaybeB #-}

1271+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)

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)

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

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

1133

1278

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

1134{-# INLINE mapAccumMaybeMB #-}

1280{-# INLINE mapAccumMaybeMB #-}

1135mapAccumMaybeMB :: (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)

1281mapAccumMaybeMB :: (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)

1136mapAccumMaybeMB f z e = do

1282mapAccumMaybeMB f z e = do

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

1140 return $ case result of

1286 return $ case result of

1141 (Nothing, Nothing) -> Nothing

1287 (Nothing, Nothing) -> Nothing

1142 _ -> Just result

1288 _ -> Just result

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

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

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

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

1145

1291

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

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

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

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

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

1285-- Cheap Functions

1431-- Cheap Functions

1286------------------

1432------------------

1287

1433

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

1288{-# INLINE pushAlwaysCheap #-}

1435{-# INLINE pushAlwaysCheap #-}

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

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

1290pushAlwaysCheap f = pushCheap (fmap Just . f)

1437pushAlwaysCheap f = pushCheap (fmap Just . f)

1291

1438

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'

1292{-# INLINE fmapMaybeCheap #-}

1445{-# INLINE fmapMaybeCheap #-}

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

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

1294−fmapMaybeCheap f = pushCheap $ return . f

1447+fmapMaybeCheap = mapMaybeCheap

1448+

1295

1449

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

1296{-# INLINE fforMaybeCheap #-}

1451{-# INLINE fforMaybeCheap #-}

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

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

1298−fforMaybeCheap = flip fmapMaybeCheap

1453+fforMaybeCheap = flip mapMaybeCheap

1299

1454

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

1300{-# INLINE fforCheap #-}

1456{-# INLINE fforCheap #-}

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

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

1302fforCheap = flip fmapCheap

1458fforCheap = flip fmapCheap

1303

1459

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

1304{-# INLINE fmapCheap #-}

1461{-# INLINE fmapCheap #-}

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

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

1306fmapCheap f = pushCheap $ return . Just . f

1463fmapCheap f = pushCheap $ return . Just . f

1307

1464

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

1308{-# INLINE tagCheap #-}

1466{-# INLINE tagCheap #-}

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

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

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

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

1311

1469

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

1312{-# INLINE mergeWithCheap #-}

1471{-# INLINE mergeWithCheap #-}

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

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

1314mergeWithCheap = mergeWithCheap' id

1473mergeWithCheap = mergeWithCheap' id

1315

1474

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

1316{-# INLINE mergeWithCheap' #-}

1476{-# INLINE mergeWithCheap' #-}

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

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

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

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

1319

1479

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

1320{-# INLINE mergeWithFoldCheap' #-}

1481{-# INLINE mergeWithFoldCheap' #-}

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

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

1322mergeWithFoldCheap' f es =

1483mergeWithFoldCheap' f es =

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

1329-- Deprecated functions

1490-- Deprecated functions

1330--------------------------------------------------------------------------------

1491--------------------------------------------------------------------------------

1331

1492

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−

1354{-# 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'. " #-}

1493{-# 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'. " #-}

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

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

1356switchPromptly = switchHoldPromptly

1495switchPromptly = switchHoldPromptly

src/Reflex/Collection.hs+150−53

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

10#ifdef USE_REFLEX_OPTIMIZER

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

12#endif

13+-- |

14+-- Module:

15+-- Reflex.Collection

13module Reflex.Collection

16module Reflex.Collection

14 (

17 (

15 -- * Widgets on Collections

18 -- * Widgets on Collections

16 listHoldWithKey

19 listHoldWithKey

17 , listWithKey

20 , listWithKey

18− , listWithKey'

19 , listWithKeyShallowDiff

21 , listWithKeyShallowDiff

20 , listViewWithKey

22 , listViewWithKey

21 , selectViewListWithKey

23 , selectViewListWithKey

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

38import Reflex.Dynamic

40import Reflex.Dynamic

39import Reflex.PostBuild.Class

41import Reflex.PostBuild.Class

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

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))

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))

42listHoldWithKey m0 m' f = do

53listHoldWithKey m0 m' f = do

43 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0

54 let dm0 = mapWithFunctorToDMap $ Map.mapWithKey f m0

55+ dm' = fmap

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

56+ (PatchDMap . mapWithFunctorToDMap . Map.mapWithKey

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

58+ )

59+ m'

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

60 (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

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+

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

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

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))

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))

50listWithKey vals mkChild = do

74listWithKey vals mkChild = do

51 postBuild <- getPostBuild

75 postBuild <- getPostBuild

52 let childValChangedSelector = fanMap $ updated vals

76 let childValChangedSelector = fanMap $ updated vals

77+

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

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

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

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

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

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

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

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

83+ -- accounted for.

84+ diffOnlyKeyChanges olds news =

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

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

57− This _ -> Just Nothing

86+ This _ -> Just Nothing

58− These _ _ -> Nothing

87+ These _ _ -> Nothing

59− That new -> Just $ Just new

88+ That new -> Just $ Just new

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

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

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

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

91+ changeVals =

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

92+ attachWith diffOnlyKeyChanges (current sentVals) $ leftmost

63− [ updated vals

93+ [ updated vals

94+

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

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

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

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

98+ -- work

99+ , tag (current vals) postBuild

65− ]

100+ ]

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

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

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

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

103

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)" #-}

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

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))

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

71−listWithKey' = listWithKeyShallowDiff

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

72−

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

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.

108+-- event to them if they do.

109+listWithKeyShallowDiff

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))

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))

75listWithKeyShallowDiff initialVals valsChanged mkChild = do

115listWithKeyShallowDiff initialVals valsChanged mkChild = do

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

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

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

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

78 let relevantPatch patch _ = case patch of

118 let relevantPatch patch _ = case patch of

119+

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

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+

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

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

126+ Just _ -> Nothing

127+ listHoldWithKey

128+ initialVals

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

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

130+ (current sentVals)

131+ valsChanged

132+ )

82− mkChild k v $ select childValChangedSelector $ Const2 k

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

83−

134+

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

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

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

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

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

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'.

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

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))

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 =

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

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

89−

149+

150+listViewWithKey'

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))

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))

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

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

156

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

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

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

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

162+ => Dynamic t k

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

163+ -- ^ Current selection key

164+ -> Dynamic t (Map k v)

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

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

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

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

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

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

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

171+ -- key of an arbitrary firing widget.

99selectViewListWithKey selection vals mkChild = do

172selectViewListWithKey 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

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

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

102 let selected = demuxed selectionDemux k

176 let selected = demuxed selectionDemux k

103 selectSelf <- mkChild k v selected

177 selectSelf <- mkChild k v selected

104 return $ fmap ((,) k) selectSelf

178 return $ fmap ((,) k) selectSelf

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

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

106

180

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

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

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

186+ => Dynamic t k

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

187+ -- ^ Current selection key

188+ -> Dynamic t (Map k v)

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

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

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

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

193+ -> m (Event t k)

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

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

195+ -- key of an arbitrary firing widget.

196+selectViewListWithKey_ selection vals mkChild =

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

197+ fmap fst <$> selectViewListWithKey selection vals mkChild

113

198

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

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

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

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

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

202+list

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))

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))

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

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

118

208

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

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

210+simpleList

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])

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 =

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

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 @@

17#ifdef USE_REFLEX_OPTIMIZER

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

19#endif

20+-- |

21+-- Module:

22+-- Reflex.Dynamic

23+-- Description:

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

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

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

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

22module Reflex.Dynamic

26module Reflex.Dynamic

23 ( -- * Basics

27 ( -- * Basics

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

28 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

58 , Demux

62 , Demux

59 , demux

63 , demux

60 , demuxed

64 , demuxed

65+ -- * Miscellaneous

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

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

62 , HList (..)

67 , HList (..)

63 , FHList (..)

68 , FHList (..)

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

67 , AllAreFunctors (..)

72 , AllAreFunctors (..)

68 , HListPtr (..)

73 , HListPtr (..)

69 , distributeFHListOverDynPure

74 , distributeFHListOverDynPure

70− -- Unsafe

75+ -- * Unsafe

71 , unsafeDynamic

76 , 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

91 ) where

77 ) where

93import Data.Functor.Compose

79import Data.Functor.Compose

94import Data.Functor.Misc

80import Data.Functor.Misc

95import Reflex.Class

81import Reflex.Class

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

98import Control.Monad

83import Control.Monad

99import Control.Monad.Fix

84import Control.Monad.Fix

100import Control.Monad.Identity

85import Control.Monad.Identity

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

102import Data.Dependent.Map (DMap)

87import Data.Dependent.Map (DMap)

103import qualified Data.Dependent.Map as DMap

88import qualified Data.Dependent.Map as DMap

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

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

105−import Data.Functor.Product

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

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

107import Data.Map (Map)

91import Data.Map (Map)

108import Data.Maybe

92import Data.Maybe

109−import Data.Monoid hiding (Product)

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

110import Data.These

94import Data.These

111

112import Debug.Trace

96import Debug.Trace

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

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

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

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

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

132

116

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/@)

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

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

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

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

136

120

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

195switchDyn d = switch (current d)

179switchDyn d = switch (current d)

196

180

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

181-- | 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

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

183-- 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'.

201--

185--

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

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

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

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

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

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

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

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

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

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

221joinDynThroughMap :: 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

239

223

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

224-- | 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

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

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

243--

227--

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

228-- 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

248

232

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

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

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

234-- 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

252-- debugging.

236-- debugging.

253--

237--

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

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

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

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

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

265-- each time the 'Event' occurs.

249-- each time the 'Event' occurs.

266--

250--

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

251+-- 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`

252+-- 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

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

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

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

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

255-- 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

256+-- 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.

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

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

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

275tagPromptlyDyn = attachPromptlyDynWith const

259tagPromptlyDyn = attachPromptlyDynWith const

276

260

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

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

278-- 'Event' each time it occurs.

262-- 'Event' each time it occurs.

279--

263--

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.

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

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

282attachPromptlyDyn = attachPromptlyDynWith (,)

266attachPromptlyDyn = attachPromptlyDynWith (,)

283

267

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

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

285-- 'Event' each time it occurs.

269-- 'Event' each time it occurs.

286--

270--

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.

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

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

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

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

290

274

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

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

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

293-- function returns 'Nothing'.

277-- function returns 'Nothing'.

294--

278--

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

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

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

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

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

298attachPromptlyDynWithMaybe f d e =

281attachPromptlyDynWithMaybe f d e =

299 let e' = attach (current d) e

282 let e' = attach (current d) e

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

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

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

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

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

304

287

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

288+-- | 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

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

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

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

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

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

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

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

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

352--

335--

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

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

354--

337--

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

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

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

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

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

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

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

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

506

489

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

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

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

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

509−-- consitutent 'Dynamic's.

492+-- constituent 'Dynamic's.

510collectDynPure :: ( RebuildSortedHList (HListElems b)

493collectDynPure :: ( RebuildSortedHList (HListElems b)

511 , IsHList a, IsHList b

494 , IsHList a, IsHList b

512 , AllAreFunctors (Dynamic t) (HListElems b)

495 , AllAreFunctors (Dynamic t) (HListElems b)

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

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

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

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

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

549#endif

532#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

13 ( qDynPure

14 , unqDyn

15 , mkDynPure

16− -- * Deprecated functions

17− , qDyn

18− , mkDyn

19 ) where

16 ) where

21import Reflex.Dynamic

18import Reflex.Dynamic

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

23import Control.Monad.State

20import Control.Monad.State

24import Data.Data

21import Data.Data

25import Data.Generics

22import Data.Generics

26−import Data.Monoid

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

27import qualified Language.Haskell.Exts as Hs

24import qualified Language.Haskell.Exts as Hs

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

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

29import Language.Haskell.TH

26import Language.Haskell.TH

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

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

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

108 | modName == modName' && occName == occName' = 'unqMarker

105 | modName == modName' && occName == occName' = 'unqMarker

109 reinstateUnqDyn x = x

106 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

22import Control.Monad.Exception

23import Control.Monad.Identity

24import Control.Monad.IO.Class

25+import Control.Monad.Primitive

25import Control.Monad.Reader

26import Control.Monad.Reader

26import Control.Monad.Ref

27import Control.Monad.Ref

27import Control.Monad.State.Strict

28import Control.Monad.State.Strict

@@ -34,7 +35,7 @@ import Data.IntMap (IntMap)

34import qualified Data.IntMap as IntMap

35import qualified Data.IntMap as IntMap

35import Data.Map (Map)

36import Data.Map (Map)

36import qualified Data.Map as Map

37import qualified Data.Map as Map

37−import Data.Semigroup

38+import Data.Semigroup (Semigroup(..))

38import Data.Some (Some)

39import Data.Some (Some)

39import Data.These

40import Data.These

@@ -87,7 +88,7 @@ mergeDynIncrementalWithMove a = unsafeBuildIncremental (mapM (sample . current)

87 noLongerMovedMap = Map.fromList $ fmap (, ()) noLongerMoved

88 noLongerMovedMap = Map.fromList $ fmap (, ()) noLongerMoved

88 in Map.differenceWith (\e _ -> Just $ MapWithMove.nodeInfoSetTo Nothing e) pWithNewVals noLongerMovedMap --TODO: Check if any in the second map are not covered?

89 in Map.differenceWith (\e _ -> Just $ MapWithMove.nodeInfoSetTo Nothing e) pWithNewVals noLongerMovedMap --TODO: Check if any in the second map are not covered?

90−-- | A basic implementation of 'MonadDynamicWriter'.

91+-- | A basic implementation of 'DynamicWriter'.

91newtype DynamicWriterT t w m a = DynamicWriterT { unDynamicWriterT :: StateT [Dynamic t w] m a }

92newtype DynamicWriterT t w m a = DynamicWriterT { unDynamicWriterT :: StateT [Dynamic t w] m a }

92 deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadAsyncException, MonadException) -- The list is kept in reverse order

93 deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadAsyncException, MonadException) -- The list is kept in reverse order

@@ -115,7 +116,7 @@ runDynamicWriterT (DynamicWriterT a) = do

115 (result, ws) <- runStateT a []

116 (result, ws) <- runStateT a []

116 return (result, mconcat $ reverse ws)

117 return (result, mconcat $ reverse ws)

117

118

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

119 tellDyn w = DynamicWriterT $ modify (w :)

120 tellDyn w = DynamicWriterT $ modify (w :)

120

121

121instance MonadReader r m => MonadReader r (DynamicWriterT t w m) where

122instance 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

140 get = lift get

141 get = lift get

141 put = lift . put

142 put = lift . put

142

143

144+instance PrimMonad m => PrimMonad (DynamicWriterT t w m) where

145+ type PrimState (DynamicWriterT t w m) = PrimState m

146+ primitive = lift . primitive

147+

143newtype DynamicWriterTLoweredResult t w v a = DynamicWriterTLoweredResult (v a, Dynamic t w)

148newtype DynamicWriterTLoweredResult t w v a = DynamicWriterTLoweredResult (v a, Dynamic t w)

144

149

145-- | When the execution of a 'DynamicWriterT' action is adjusted using

150-- | 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 #-}

2{-# LANGUAGE CPP #-}

3{-# LANGUAGE CPP #-}

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FunctionalDependencies #-}

5{-# LANGUAGE FunctionalDependencies #-}

@@ -8,17 +9,21 @@

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

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

9#endif

10#endif

10module Reflex.DynamicWriter.Class

11module Reflex.DynamicWriter.Class

11− ( MonadDynamicWriter (..)

12+ ( MonadDynamicWriter

13+ , DynamicWriter(..)

12 ) where

14 ) where

14import Control.Monad.Reader (ReaderT, lift)

16import Control.Monad.Reader (ReaderT, lift)

15import Reflex.Class (Dynamic)

17import Reflex.Class (Dynamic)

19+{-# DEPRECATED MonadDynamicWriter "Use 'DynamicWriter' instead" #-}

20+type MonadDynamicWriter = DynamicWriter

21+

17-- | 'MonadDynamicWriter' efficiently collects 'Dynamic' values using 'tellDyn'

22-- | 'MonadDynamicWriter' efficiently collects 'Dynamic' values using 'tellDyn'

18-- and combines them monoidally to provide a 'Dynamic' result.

23-- 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

20 tellDyn :: Dynamic t w -> m ()

25 tellDyn :: Dynamic t w -> m ()

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

23 tellDyn = lift . tellDyn

28 tellDyn = lift . tellDyn

src/Reflex/EventWriter/Base.hs+2−2

@@ -25,7 +25,7 @@ module Reflex.EventWriter.Base

25import Reflex.Adjustable.Class

26import Reflex.Class

27import Reflex.EventWriter.Class (EventWriter, tellEvent)

28−import Reflex.DynamicWriter.Class (MonadDynamicWriter, tellDyn)

28+import Reflex.DynamicWriter.Class (DynamicWriter, tellDyn)

29import Reflex.Host.Class

30import Reflex.PerformEvent.Class

31import Reflex.PostBuild.Class

@@ -278,7 +278,7 @@ instance (MonadQuery t q m, Monad m) => MonadQuery t q (EventWriterT t w m) wher

278 askQueryResult = lift askQueryResult

279 queryIncremental = lift . queryIncremental

280

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

282 tellDyn = lift . tellDyn

283

284instance PrimMonad m => PrimMonad (EventWriterT t w m) where

src/Reflex/FastWeak.hs+59−5

@@ -5,6 +5,19 @@

5{-# LANGUAGE ForeignFunctionInterface #-}

6{-# LANGUAGE JavaScriptFFI #-}

7#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.

8module Reflex.FastWeak

21module Reflex.FastWeak

9 ( FastWeakTicket

22 ( FastWeakTicket

10 , FastWeak

23 , FastWeak

@@ -35,29 +48,57 @@ import System.Mem.Weak

37#ifdef GHCJS_FAST_WEAK

50#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@.

38newtype FastWeakTicket a = FastWeakTicket JSVal

56newtype FastWeakTicket a = FastWeakTicket JSVal

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@.

40newtype FastWeak a = FastWeak JSVal

67newtype FastWeak a = FastWeak JSVal

42-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two

69-- Just designed to mirror JSVal, so that we can unsafeCoerce between the two

43data Val a = Val { unVal :: a }

70data Val a = Val { unVal :: a }

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@

46unsafeFromRawJSVal :: JSVal -> a

73unsafeFromRawJSVal :: JSVal -> a

47unsafeFromRawJSVal v = unVal (unsafeCoerce v)

74unsafeFromRawJSVal v = unVal (unsafeCoerce v)

76+-- | Coerce a heap object of type @a@ into a 'JSVal' which represents that object.

49unsafeToRawJSVal :: a -> JSVal

77unsafeToRawJSVal :: a -> JSVal

50unsafeToRawJSVal v = unsafeCoerce (Val v)

78unsafeToRawJSVal v = unsafeCoerce (Val v)

51#else

79#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.

52data FastWeakTicket a = FastWeakTicket

83data FastWeakTicket a = FastWeakTicket

53 { _fastWeakTicket_val :: !a

84 { _fastWeakTicket_val :: !a

54 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)

85 , _fastWeakTicket_weak :: {-# UNPACK #-} !(Weak a)

55 }

86 }

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'.

57type FastWeak a = Weak a

96type FastWeak a = Weak a

58#endif

97#endif

99+-- | Return the @a@ kept alive by the given 'FastWeakTicket'.

100+--

60−-- This needs to be in IO so we know that we've relinquished the ticket

101+-- This needs to be in IO so we know that we've relinquished the ticket.

61getFastWeakTicketValue :: FastWeakTicket a -> IO a

102getFastWeakTicketValue :: FastWeakTicket a -> IO a

62#ifdef GHCJS_FAST_WEAK

103#ifdef GHCJS_FAST_WEAK

63getFastWeakTicketValue t = do

104getFastWeakTicketValue t = do

@@ -69,6 +110,8 @@ foreign import javascript unsafe "$r = $1.val;" js_ticketVal :: FastWeakTicket a

69getFastWeakTicketValue = return . _fastWeakTicket_val

110getFastWeakTicketValue = return . _fastWeakTicket_val

70#endif

111#endif

112

113+-- | Get the value referred to by a 'FastWeak' if it hasn't yet been collected,

114+-- or @Nothing@ if it has been collected.

72getFastWeakValue :: FastWeak a -> IO (Maybe a)

115getFastWeakValue :: FastWeak a -> IO (Maybe a)

73#ifdef GHCJS_FAST_WEAK

116#ifdef GHCJS_FAST_WEAK

74getFastWeakValue w = do

117getFastWeakValue w = do

@@ -84,6 +127,9 @@ foreign import javascript unsafe "$r = ($1.ticket === null) ? null : $1.ticket.v

84getFastWeakValue = deRefWeak

127getFastWeakValue = deRefWeak

85#endif

128#endif

129

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.

87getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))

133getFastWeakTicket :: forall a. FastWeak a -> IO (Maybe (FastWeakTicket a))

88#ifdef GHCJS_FAST_WEAK

134#ifdef GHCJS_FAST_WEAK

89getFastWeakTicket w = do

135getFastWeakTicket w = do

@@ -103,8 +149,11 @@ getFastWeakTicket w = do

103 }

149 }

104#endif

150#endif

105

151

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'.

107mkFastWeakTicket :: a -> IO (FastWeakTicket a)

154mkFastWeakTicket :: 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

108#ifdef GHCJS_FAST_WEAK

157#ifdef GHCJS_FAST_WEAK

109mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)

158mkFastWeakTicket v = js_fastWeakTicket (unsafeToRawJSVal v)

110

159

@@ -119,11 +168,16 @@ mkFastWeakTicket v = do

119 }

168 }

120#endif

169#endif

121

170

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)

122-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value

175-- Needs IO so that it can force the value - otherwise, could end up with a reference to the Ticket, which would retain the value

123#ifdef GHCJS_FAST_WEAK

176#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'

125#else

180#else

126−getFastWeakTicketWeak :: FastWeakTicket a -> IO (FastWeak a)

127getFastWeakTicketWeak = return . _fastWeakTicket_weak

181getFastWeakTicketWeak = return . _fastWeakTicket_weak

128#endif

182#endif

129

183

src/Reflex/FunctorMaybe.hs+23−21

@@ -1,43 +1,45 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE StandaloneDeriving #-}

5+-- |

6+-- Module:

7+-- Reflex.FunctorMaybe

8+-- Description:

1−-- | This module defines the FunctorMaybe class, which extends Functors with the

9+-- This module defines the FunctorMaybe class, which extends Functors with the

2−-- ability to delete values.

10+-- ability to delete values.

3module Reflex.FunctorMaybe

11module Reflex.FunctorMaybe

4 ( FunctorMaybe (..)

12 ( FunctorMaybe (..)

5 ) where

13 ) where

7import Data.IntMap (IntMap)

15import Data.IntMap (IntMap)

8−import qualified Data.IntMap as IntMap

9import Data.Map (Map)

16import Data.Map (Map)

10−import qualified Data.Map as Map

17+#if MIN_VERSION_base(4,9,0)

18+import Data.Semigroup (Option(..))

19+#endif

11−import Data.Maybe

20+import Data.Witherable

13--TODO: See if there's a better class in the standard libraries already

22--TODO: See if there's a better class in the standard libraries already

15-- | A class for values that combines filtering and mapping using 'Maybe'.

24-- | A class for values that combines filtering and mapping using 'Maybe'.

16−-- Morally, @'FunctorMaybe' ~ KleisliFunctor 'Maybe'@. Also similar is the

25+-- Morally, @'FunctorMaybe' ~ KleisliFunctor 'Maybe'@.

17−-- @Witherable@ typeclass, but it requires @Foldable f@ and @Traverable f@,

26+{-# DEPRECATED FunctorMaybe "Use 'Filterable' from Data.Witherable instead" #-}

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@

27class FunctorMaybe f where

28 -- | Combined mapping and filtering function.

29 fmapMaybe :: (a -> Maybe b) -> f a -> f b

31−-- | @fmapMaybe = (=<<)

32instance FunctorMaybe Maybe where

31instance FunctorMaybe Maybe where

33− fmapMaybe = (=<<)

32+ fmapMaybe = mapMaybe

33+

34+#if MIN_VERSION_base(4,9,0)

35+deriving instance FunctorMaybe Option

36+#endif

35−-- | @fmapMaybe = mapMaybe@

36instance FunctorMaybe [] where

38instance FunctorMaybe [] where

37 fmapMaybe = mapMaybe

39 fmapMaybe = mapMaybe

39instance FunctorMaybe (Map k) where

41instance FunctorMaybe (Map k) where

40− fmapMaybe = Map.mapMaybe

42+ fmapMaybe = mapMaybe

42instance FunctorMaybe IntMap where

44instance FunctorMaybe IntMap where

43− fmapMaybe = IntMap.mapMaybe

45+ fmapMaybe = mapMaybe

src/Reflex/Network.hs+10−4

@@ -3,6 +3,11 @@

3#ifdef USE_REFLEX_OPTIMIZER

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

5#endif

6+-- |

7+-- Module:

8+-- Reflex.Network

9+-- Description:

10+-- This module provides combinators for building FRP graphs/networks and modifying them dynamically.

6module Reflex.Network

11module Reflex.Network

7 ( networkView

12 ( networkView

8 , networkHold

13 , networkHold

@@ -14,16 +19,17 @@ import Reflex.Adjustable.Class

14import Reflex.NotReady.Class

19import Reflex.NotReady.Class

15import Reflex.PostBuild.Class

20import Reflex.PostBuild.Class

17−-- | Given a Dynamic of network-creating actions, create a network that is recreated whenever the Dynamic updates.

22+-- | A 'Dynamic' "network": Takes a 'Dynamic' of network-creating actions and replaces the network whenever the 'Dynamic' updates.

18−-- The returned Event of network results occurs when the Dynamic does.

23+-- The returned Event of network results fires when the 'Dynamic' updates.

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').

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').

20networkView :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)

26networkView :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)

21networkView child = do

27networkView child = do

22 postBuild <- getPostBuild

28 postBuild <- getPostBuild

23 let newChild = leftmost [updated child, tagCheap (current child) postBuild]

29 let newChild = leftmost [updated child, tagCheap (current child) postBuild]

24 snd <$> runWithReplace notReady newChild

30 snd <$> runWithReplace notReady newChild

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.

27-- The returned Dynamic of network results occurs when the Event does.

33-- The returned Dynamic of network results occurs when the Event does.

28-- Note: Often, the type 'a' is an Event, in which case the return value is a Dynamic-of-Events that would typically be flattened.

34-- Note: Often, the type 'a' is an Event, in which case the return value is a Dynamic-of-Events that would typically be flattened.

29networkHold :: (Adjustable t m, MonadHold t m) => m a -> Event t (m a) -> m (Dynamic t a)

35networkHold :: (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

16import Control.Monad.Reader (ReaderT)

17import Control.Monad.Trans

18+import Control.Monad.Trans.Writer (WriterT)

20+import Reflex.BehaviorWriter.Base (BehaviorWriterT)

19import Reflex.Class

21import Reflex.Class

20import Reflex.DynamicWriter.Base (DynamicWriterT)

22import Reflex.DynamicWriter.Base (DynamicWriterT)

21import Reflex.EventWriter.Base (EventWriterT)

23import Reflex.EventWriter.Base (EventWriterT)

@@ -39,6 +41,10 @@ instance NotReady t m => NotReady t (ReaderT r m) where

39 notReadyUntil = lift . notReadyUntil

41 notReadyUntil = lift . notReadyUntil

40 notReady = lift notReady

42 notReady = lift notReady

44+instance (NotReady t m, Monoid w) => NotReady t (WriterT w m) where

45+ notReadyUntil = lift . notReadyUntil

46+ notReady = lift notReady

47+

42instance NotReady t m => NotReady t (PostBuildT t m) where

48instance NotReady t m => NotReady t (PostBuildT t m) where

43 notReadyUntil = lift . notReadyUntil

49 notReadyUntil = lift . notReadyUntil

44 notReady = lift notReady

50 notReady = lift notReady

@@ -51,6 +57,10 @@ instance NotReady t m => NotReady t (DynamicWriterT t w m) where

51 notReadyUntil = lift . notReadyUntil

57 notReadyUntil = lift . notReadyUntil

52 notReady = lift notReady

58 notReady = lift notReady

60+instance NotReady t m => NotReady t (BehaviorWriterT t w m) where

61+ notReadyUntil = lift . notReadyUntil

62+ notReady = lift notReady

63+

54instance NotReady t m => NotReady t (QueryT t q m) where

64instance NotReady t m => NotReady t (QueryT t q m) where

55 notReadyUntil = lift . notReadyUntil

65 notReadyUntil = lift . notReadyUntil

56 notReady = lift notReady

66 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.

5{-# LANGUAGE CPP #-}

1{-# LANGUAGE CPP #-}

6{-# LANGUAGE LambdaCase #-}

2{-# LANGUAGE LambdaCase #-}

7{-# LANGUAGE OverloadedStrings #-}

3{-# 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.

8module Reflex.Optimizer

12module Reflex.Optimizer

9 ( plugin

13 ( plugin

10 ) where

14 ) 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.

3{-# LANGUAGE TypeFamilies #-}

1{-# 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.

4module Reflex.Patch

8module Reflex.Patch

5 ( module Reflex.Patch

9 ( module Reflex.Patch

6 , module X

10 , module X

@@ -17,11 +21,9 @@ import Reflex.Patch.Map as X

17import Reflex.Patch.MapWithMove as X (PatchMapWithMove, patchMapWithMoveNewElements,

21import Reflex.Patch.MapWithMove as X (PatchMapWithMove, patchMapWithMoveNewElements,

18 patchMapWithMoveNewElementsMap, unPatchMapWithMove,

22 patchMapWithMoveNewElementsMap, unPatchMapWithMove,

19 unsafePatchMapWithMove)

23 unsafePatchMapWithMove)

20−

24+import Data.Map.Monoidal (MonoidalMap)

21import Data.Semigroup (Semigroup (..), (<>))

25import Data.Semigroup (Semigroup (..), (<>))

23−---- Patches based on commutative groups

24−

25-- | A 'Group' is a 'Monoid' where every element has an inverse.

27-- | A 'Group' is a 'Monoid' where every element has an inverse.

26class (Semigroup q, Monoid q) => Group q where

28class (Semigroup q, Monoid q) => Group q where

27 negateG :: q -> q

29 negateG :: q -> q

@@ -37,3 +39,8 @@ newtype AdditivePatch p = AdditivePatch { unAdditivePatch :: p }

37instance Additive p => Patch (AdditivePatch p) where

39instance Additive p => Patch (AdditivePatch p) where

38 type PatchTarget (AdditivePatch p) = p

40 type PatchTarget (AdditivePatch p) = p

39 apply (AdditivePatch p) q = Just $ p <> q

41 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

5import Control.Monad.Identity

6import Data.Maybe

7−import Data.Semigroup

7+import Data.Semigroup (Semigroup(..))

9-- | A 'Patch' type represents a kind of change made to a datastructure.

10--

src/Reflex/Patch/DMap.hs+22−8

@@ -5,6 +5,7 @@

5{-# LANGUAGE ScopedTypeVariables #-}

6{-# LANGUAGE StandaloneDeriving #-}

7{-# LANGUAGE TypeFamilies #-}

8+-- | 'Patch'es on 'DMap' that consist only of insertions (or overwrites) and deletions.

8module Reflex.Patch.DMap where

9module Reflex.Patch.DMap where

10import Reflex.Patch.Class

11import Reflex.Patch.Class

@@ -20,14 +21,16 @@ import qualified Data.Map as Map

20import Data.Semigroup (Semigroup (..))

21import Data.Semigroup (Semigroup (..))

21import Data.Some (Some)

22import Data.Some (Some)

23−-- | A set of changes to a 'DMap'. Any element may be inserted/updated or

24+-- | A set of changes to a 'DMap'. Any element may be inserted/updated or deleted.

24−-- deleted.

25+-- Insertions are represented as @'ComposeMaybe' (Just value)@,

26+-- while deletions are represented as @'ComposeMaybe' Nothing@.

25newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }

27newtype PatchDMap k v = PatchDMap { unPatchDMap :: DMap k (ComposeMaybe v) }

27deriving instance GCompare k => Semigroup (PatchDMap k v)

29deriving instance GCompare k => Semigroup (PatchDMap k v)

29deriving instance GCompare k => Monoid (PatchDMap k v)

31deriving instance GCompare k => Monoid (PatchDMap k v)

33+-- | Apply the insertions or deletions to a given 'DMap'.

31instance GCompare k => Patch (PatchDMap k v) where

34instance GCompare k => Patch (PatchDMap k v) where

32 type PatchTarget (PatchDMap k v) = DMap k v

35 type PatchTarget (PatchDMap k v) = DMap k v

33 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?

36 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

37 Nothing -> Just $ Constant ()

40 Nothing -> Just $ Constant ()

38 Just _ -> Nothing

41 Just _ -> Nothing

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'@.

40mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'

45mapPatchDMap :: (forall a. v a -> v' a) -> PatchDMap k v -> PatchDMap k v'

41mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p

46mapPatchDMap f (PatchDMap p) = PatchDMap $ DMap.map (ComposeMaybe . fmap f . getComposeMaybe) p

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'@.

43−traversePatchDMap :: Applicative m => (forall a. v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')

50+traversePatchDMap :: Applicative f => (forall a. v a -> f (v' a)) -> PatchDMap k v -> f (PatchDMap k v')

44traversePatchDMap f = traversePatchDMapWithKey $ const f

51traversePatchDMap f = traversePatchDMapWithKey $ const f

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'@.

46traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')

55traversePatchDMapWithKey :: Applicative m => (forall a. k a -> v a -> m (v' a)) -> PatchDMap k v -> m (PatchDMap k v')

47traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p

56traversePatchDMapWithKey f (PatchDMap p) = PatchDMap <$> DMap.traverseWithKey (\k (ComposeMaybe v) -> ComposeMaybe <$> traverse (f k) v) p

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.

49weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'

60weakenPatchDMapWith :: (forall a. v a -> v') -> PatchDMap k v -> PatchMap (Some k) v'

50weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p

61weakenPatchDMapWith f (PatchDMap p) = PatchMap $ weakenDMapWith (fmap f . getComposeMaybe) p

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'@.

52−patchDMapToPatchMapWith :: (f v -> v') -> PatchDMap (Const2 k v) f -> PatchMap k v'

65+patchDMapToPatchMapWith :: (v a -> v') -> PatchDMap (Const2 k a) v -> PatchMap k v'

53patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p

66patchDMapToPatchMapWith f (PatchDMap p) = PatchMap $ dmapToMapWith (fmap f . getComposeMaybe) p

68+-- | Convert a @'PatchMap' k v@ into a @'PatchDMap' ('Const2' k a) v'@ using a function @v -> v' a@.

55−const2PatchDMapWith :: forall k v f a. (v -> f a) -> PatchMap k v -> PatchDMap (Const2 k a) f

69+const2PatchDMapWith :: forall k v v' a. (v -> v' a) -> PatchMap k v -> PatchDMap (Const2 k a) v'

56const2PatchDMapWith f (PatchMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> Map.toAscList p

70const2PatchDMapWith 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')

58 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

72 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

74+-- | Convert a @'PatchIntMap' v@ into a @'PatchDMap' ('Const2' Int a) v'@ using a function @v -> v' a@.

60const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f

75const2IntPatchDMapWith :: forall v f a. (v -> f a) -> PatchIntMap v -> PatchDMap (Const2 IntMap.Key a) f

61const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p

76const2IntPatchDMapWith f (PatchIntMap p) = PatchDMap $ DMap.fromDistinctAscList $ g <$> IntMap.toAscList p

62 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)

77 where g :: (IntMap.Key, Maybe v) -> DSum (Const2 IntMap.Key a) (ComposeMaybe f)

63 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

78 g (k, e) = Const2 k :=> ComposeMaybe (f <$> e)

65−-- | Get the values that will be deleted if the given patch is applied to the

80+-- | Get the values that will be replaced or deleted if the given patch is applied to the given 'DMap'.

66−-- given 'DMap'. Includes values that will be replaced.

67getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'

81getDeletions :: GCompare k => PatchDMap k v -> DMap k v' -> DMap k v'

68getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p

82getDeletions (PatchDMap p) m = DMap.intersectionWithKey (\_ v _ -> v) m p

src/Reflex/Patch/DMapWithMove.hs+3−2

@@ -104,6 +104,7 @@ validationErrorsForPatchDMapWithMove m =

104 Just $ "unbalanced move at source key " <> gshow src <> " supposedly going to " <> gshow dst <> " but destination key is not moving"

105 unbalancedMove _ = Nothing

106

107+-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.

107instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where

108instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where

108 PatchDMapWithMove a == PatchDMapWithMove b = a == b

109 PatchDMapWithMove a == PatchDMapWithMove b = a == b

109

110

@@ -341,6 +342,7 @@ const2PatchDMapWithMoveWith f (PatchMapWithMove p) = PatchDMapWithMove $ DMap.fr

341 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni

342 , _nodeInfo_to = ComposeMaybe $ Const2 <$> MapWithMove._nodeInfo_to ni

342 }

343 }

343

344

345+-- | Apply the insertions, deletions, and moves to a given 'DMap'.

344instance GCompare k => Patch (PatchDMapWithMove k v) where

346instance GCompare k => Patch (PatchDMapWithMove k v) where

345 type PatchTarget (PatchDMapWithMove k v) = DMap k v

347 type PatchTarget (PatchDMapWithMove k v) = DMap k v

346 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?

348 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

356 From_Delete -> Just $ Constant ()

358 From_Delete -> Just $ Constant ()

357 _ -> Nothing

359 _ -> Nothing

358

360

359−-- | Get the values that will be deleted or moved if the given patch is applied

361+-- | Get the values that will be replaced, deleted, or moved if the given patch is applied to the given 'DMap'.

360−-- to the given 'DMap'.

361getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))

362getDeletionsAndMoves :: GCompare k => PatchDMapWithMove k v -> DMap k v' -> DMap k (Product v' (ComposeMaybe k))

362getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p

363getDeletionsAndMoves (PatchDMapWithMove p) m = DMap.intersectionWithKey f m p

363 where f _ v ni = Pair v $ _nodeInfo_to ni

364 where f _ v ni = Pair v $ _nodeInfo_to ni

src/Reflex/Patch/IntMap.hs+19−1

@@ -4,6 +4,8 @@

4{-# LANGUAGE DeriveTraversable #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE TypeFamilies #-}

7+-- | Module containing 'PatchIntMap', a 'Patch' for 'IntMap' which allows for

8+-- insert/update or delete of associations.

7module Reflex.Patch.IntMap where

9module Reflex.Patch.IntMap where

9import Data.IntMap.Strict (IntMap)

11import Data.IntMap.Strict (IntMap)

@@ -12,8 +14,12 @@ import Data.Maybe

12import Data.Semigroup

14import Data.Semigroup

13import Reflex.Patch.Class

15import Reflex.Patch.Class

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.

15newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)

20newtype PatchIntMap a = PatchIntMap (IntMap (Maybe a)) deriving (Functor, Foldable, Traversable, Monoid)

22+-- | Apply the insertions or deletions to a given 'IntMap'.

17instance Patch (PatchIntMap a) where

23instance Patch (PatchIntMap a) where

18 type PatchTarget (PatchIntMap a) = IntMap a

24 type PatchTarget (PatchIntMap a) = IntMap a

19 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $

25 apply (PatchIntMap p) v = if IntMap.null p then Nothing else Just $

@@ -36,14 +42,26 @@ instance Semigroup (PatchIntMap v) where

36 GT -> x

42 GT -> x

37#endif

43#endif

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)@.

39−traverseIntMapPatchWithKey :: Applicative t => (Int -> a -> t b) -> PatchIntMap a -> t (PatchIntMap b)

52+traverseIntMapPatchWithKey :: Applicative f => (Int -> a -> f b) -> PatchIntMap a -> f (PatchIntMap b)

40traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m

53traverseIntMapPatchWithKey f (PatchIntMap m) = PatchIntMap <$> IntMap.traverseWithKey (\k mv -> traverse (f k) mv) m

55+-- | Extract all @a@s inserted/updated by the given @'PatchIntMap' a@.

42patchIntMapNewElements :: PatchIntMap a -> [a]

56patchIntMapNewElements :: PatchIntMap a -> [a]

43patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m

57patchIntMapNewElements (PatchIntMap m) = catMaybes $ IntMap.elems m

59+-- | Convert the given @'PatchIntMap' a@ into an @'IntMap' a@ with all

60+-- the inserts/updates in the given patch.

45patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

61patchIntMapNewElementsMap :: PatchIntMap a -> IntMap a

46patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m

62patchIntMapNewElementsMap (PatchIntMap m) = IntMap.mapMaybe id m

64+-- | Subset the given @'IntMap' a@ to contain only the keys that would be

65+-- deleted by the given @'PatchIntMap' a@.

48getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'

66getDeletions :: PatchIntMap v -> IntMap v' -> IntMap v'

49getDeletions (PatchIntMap m) v = IntMap.intersection v m

67getDeletions (PatchIntMap m) v = IntMap.intersection v m

src/Reflex/Patch/Map.hs+1−2

@@ -18,8 +18,7 @@ import Data.Semigroup

18newtype PatchMap k v = PatchMap { unPatchMap :: Map k (Maybe v) }

19 deriving (Show, Read, Eq, Ord)

21−-- | Applying a 'PatchMap' will update the 'Map' by performing the insertions

21+-- | Apply the insertions or deletions to a given 'Map'.

22−-- and deletions specified

23instance Ord k => Patch (PatchMap k v) where

22instance Ord k => Patch (PatchMap k v) where

24 type PatchTarget (PatchMap k v) = Map k v

23 type PatchTarget (PatchMap k v) = Map k v

25 {-# INLINABLE apply #-}

24 {-# INLINABLE apply #-}

src/Reflex/Patch/MapWithMove.hs+59−17

@@ -20,9 +20,9 @@ import Data.List

20import Data.Map (Map)

21import qualified Data.Map as Map

22import Data.Maybe

23−import Data.Semigroup

23+import Data.Semigroup (Semigroup (..), (<>))

24import qualified Data.Set as Set

25−import Data.These

25+import Data.These (These(..))

26import Data.Tuple

28-- | Patch a DMap with additions, deletions, and moves. Invariant: If key @k1@

@@ -41,6 +41,18 @@ data NodeInfo k v = NodeInfo

41 }

42 deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

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+

44-- | Create a 'PatchMapWithMove', validating it

56-- | Create a 'PatchMapWithMove', validating it

45patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)

57patchMapWithMove :: Ord k => Map k (NodeInfo k v) -> Maybe (PatchMapWithMove k v)

46patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing

58patchMapWithMove m = if valid then Just $ PatchMapWithMove m else Nothing

@@ -62,22 +74,51 @@ patchMapWithMoveInsertAll m = PatchMapWithMove $ flip fmap m $ \v -> NodeInfo

62unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

74unPatchMapWithMove :: PatchMapWithMove k v -> Map k (NodeInfo k v)

63unPatchMapWithMove (PatchMapWithMove p) = p

75unPatchMapWithMove (PatchMapWithMove p) = p

65−-- | Warning: when using this function, you must ensure that the invariants of

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'.

66−-- 'PatchMapWithMove' are preserved; they will not be checked.

78+insertMapKey :: k -> v -> PatchMapWithMove k v

67−unsafePatchMapWithMove :: Map k (NodeInfo k v) -> PatchMapWithMove k v

79+insertMapKey k v = PatchMapWithMove . Map.singleton k $ NodeInfo (From_Insert v) Nothing

68−unsafePatchMapWithMove = PatchMapWithMove

70−-- | Describe how a key's new value should be produced

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:

71−data From k v

82+--

72− = From_Insert v -- ^ Insert the given value here

83+-- @

73− | From_Delete -- ^ Delete the existing value, if any, from here

84+-- 'Map.delete' src (maybe map ('Map.insert' dst) (Map.lookup src map))

74− | From_Move !k -- ^ Move the value here from the given key

85+-- @

75− deriving (Show, Read, Eq, Ord, Functor, Foldable, Traversable)

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+ ]

77−-- | Describe where a key's old value will go. If this is 'Just', that means

95+-- |Make a @'PatchMapWithMove' k v@ which has the effect of swapping two keys in the mapping, equivalent to:

78−-- the key's old value will be moved to the given other key; if it is 'Nothing',

96+--

79−-- that means it will be deleted.

97+-- @

80−type To = Maybe

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

122

82-- | Apply the insertions, deletions, and moves to a given 'Map'

123-- | Apply the insertions, deletions, and moves to a given 'Map'

83instance Ord k => Patch (PatchMapWithMove k v) where

124instance Ord k => Patch (PatchMapWithMove k v) where

@@ -91,10 +132,11 @@ instance Ord k => Patch (PatchMapWithMove k v) where

91 From_Delete -> Just ()

132 From_Delete -> Just ()

92 _ -> Nothing

133 _ -> Nothing

134

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'.

95patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]

136patchMapWithMoveNewElements :: PatchMapWithMove k v -> [v]

96patchMapWithMoveNewElements = Map.elems . patchMapWithMoveNewElementsMap

137patchMapWithMoveNewElements = Map.elems . patchMapWithMoveNewElementsMap

138

139+-- | Return a @'Map' k v@ with all the inserts/updates from the given @'PatchMapWithMove' k v@.

98patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v

140patchMapWithMoveNewElementsMap :: PatchMapWithMove k v -> Map k v

99patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p

141patchMapWithMoveNewElementsMap (PatchMapWithMove p) = Map.mapMaybe f p

100 where f ni = case _nodeInfo_from ni of

142 where f ni = case _nodeInfo_from ni of

src/Reflex/Profiled.hs+6

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

8{-# LANGUAGE StandaloneDeriving #-}

9{-# LANGUAGE TypeFamilies #-}

10{-# 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.

11module Reflex.Profiled where

17module Reflex.Profiled where

13import Control.Lens hiding (children)

19import Control.Lens hiding (children)

src/Reflex/Pure.hs+11−9

@@ -13,11 +13,13 @@

13-- * MonadSample (Pure t) ((->) t)

14-- * MonadHold (Pure t) ((->) t)

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

16−

16+-- |

17+-- Module: Reflex.Pure

18+-- Description:

17−-- | This module provides a pure implementation of Reflex, which is intended to

19+-- 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

20+-- serve as a reference for the semantics of the Reflex class. All

19−-- implementations of Reflex should produce the same results as this

21+-- implementations of Reflex should produce the same results as this

20−-- implementation, although performance and laziness/strictness may differ.

22+-- implementation, although performance and laziness/strictness may differ.

21module Reflex.Pure

23module Reflex.Pure

22 ( Pure

24 ( Pure

23 , Behavior (..)

25 , Behavior (..)

@@ -43,12 +45,12 @@ import Data.Type.Coercion

43import Reflex.Class

45import Reflex.Class

45-- | A completely pure-functional 'Reflex' timeline, identifying moments in time

47-- | A completely pure-functional 'Reflex' timeline, identifying moments in time

46−-- with the type @t@.

48+-- with the type @/t/@.

47data Pure t

49data Pure t

49−-- | The Enum instance of t must be dense: for all x :: t, there must not exist

51+-- | 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

52+-- 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.

53+-- exclusively to memoize functions of @/t/@, not for any of its other capabilities.

52instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

54instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where

54 newtype Behavior (Pure t) a = Behavior { unBehavior :: t -> a }

56 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

333instance EventWriter t w m => EventWriter t w (QueryT t q m) where

334 tellEvent = lift . tellEvent

335

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

337 tellDyn = lift . tellDyn

src/Reflex/Query/Class.hs+1−1

@@ -27,7 +27,7 @@ import Data.Data

27import Data.Ix

28import Data.Map.Monoidal (MonoidalMap)

29import qualified Data.Map.Monoidal as MonoidalMap

30−import Data.Semigroup

30+import Data.Semigroup (Semigroup(..))

31import Foreign.Storable

33import Reflex.Class

src/Reflex/Requester/Base.hs+112−3

@@ -21,14 +21,20 @@

21module Reflex.Requester.Base

22 ( RequesterT (..)

23 , runRequesterT

24+ , withRequesterT

24 , runWithReplaceRequesterTWith

25 , runWithReplaceRequesterTWith

25 , traverseIntMapWithKeyWithAdjustRequesterTWith

26 , traverseIntMapWithKeyWithAdjustRequesterTWith

26 , traverseDMapWithKeyWithAdjustRequesterTWith

27 , traverseDMapWithKeyWithAdjustRequesterTWith

27 , RequesterData

28 , RequesterData

28 , RequesterDataKey

29 , RequesterDataKey

29 , traverseRequesterData

30 , traverseRequesterData

31+ , forRequesterData

30 , requesterDataToList

32 , requesterDataToList

31 , singletonRequesterData

33 , singletonRequesterData

34+ , matchResponsesWithRequests

35+ , multiEntry

36+ , unMultiEntry

37+ , requesting'

32 ) where

38 ) where

34import Reflex.Class

40import Reflex.Class

@@ -43,6 +49,7 @@ import Reflex.TriggerEvent.Class

43import Control.Applicative (liftA2)

49import Control.Applicative (liftA2)

44import Control.Monad.Exception

50import Control.Monad.Exception

45import Control.Monad.Identity

51import Control.Monad.Identity

52+import Control.Monad.Primitive

46import Control.Monad.Reader

53import Control.Monad.Reader

47import Control.Monad.Ref

54import Control.Monad.Ref

48import Control.Monad.State.Strict

55import Control.Monad.State.Strict

@@ -130,6 +137,10 @@ traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWith

130 MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request

137 MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request

131 MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request

138 MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request

132

139

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+

133data MyTagType :: * -> * where

144data MyTagType :: * -> * where

134 MyTagType_Single :: MyTagType (Single a)

145 MyTagType_Single :: MyTagType (Single a)

135 MyTagType_Multi :: MyTagType Multi

146 MyTagType_Multi :: MyTagType Multi

@@ -239,6 +250,10 @@ deriving instance MonadHold t m => MonadHold t (RequesterT t request response m)

239deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)

250deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)

240deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)

251deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)

241

252

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+

242-- TODO: Monoid and Semigroup can likely be derived once StateT has them.

257-- TODO: Monoid and Semigroup can likely be derived once StateT has them.

243instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where

258instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where

244 mempty = pure mempty

259 mempty = pure mempty

@@ -252,7 +267,6 @@ instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response

252-- requests are made, and responses should be provided in the input 'Event'.

267-- requests are made, and responses should be provided in the input 'Event'.

253-- The 'Tag' keys will be used to return the responses to the same place the

268-- The 'Tag' keys will be used to return the responses to the same place the

254-- requests were issued.

269-- requests were issued.

255−

256runRequesterT :: (Reflex t, Monad m)

270runRequesterT :: (Reflex t, Monad m)

257 => RequesterT t request response m a

271 => RequesterT t request response m a

258 -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse

272 -> 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

262 coerceEvent responses

276 coerceEvent responses

263 return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)

277 return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)

264

278

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+

265instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where

293instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where

266 type Request (RequesterT t request response m) = request

294 type Request (RequesterT t request response m) = request

267 type Response (RequesterT t request response m) = response

295 type Response (RequesterT t request response m) = response

@@ -365,7 +393,7 @@ traverseIntMapWithKeyWithAdjustRequesterTWith base patchNewElements mergePatchIn

365 pack = Entry

393 pack = Entry

366 f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')

394 f' :: IntMap.Key -> (Int, v) -> m (Event t (IntMap (RequesterData request)), v')

367 f' k (n, v) = do

395 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?

369 return (fmapCheap (IntMap.singleton n) myRequests, result)

397 return (fmapCheap (IntMap.singleton n) myRequests, result)

370 ndm' <- numberOccurrencesFrom 1 dm'

398 ndm' <- numberOccurrencesFrom 1 dm'

371 (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

399 (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

413 pack = Entry

441 pack = Entry

414 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)

442 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)

415 f' k (Compose (n, v)) = do

443 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))

417 return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)

445 return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)

418 ndm' <- numberOccurrencesFrom 1 dm'

446 ndm' <- numberOccurrencesFrom 1 dm'

419 (children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'

447 (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

427 promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'

455 promptRequests = coincidence $ fmapCheap (mergeMap . patchNewElements) requests' --TODO: Create a mergeIncrementalPromptly, and use that to eliminate this 'coincidence'

428 requests <- holdIncremental requests0 requests'

456 requests <- holdIncremental requests0 requests'

429 return (result0, result')

457 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 @@

1{-# LANGUAGE CPP #-}

2+-- |

3+-- Module:

4+-- Reflex.Spider

5+-- Description:

2−-- | This module exports all of the user-facing functionality of the 'Spider'

6+-- This module exports all of the user-facing functionality of the 'Spider' 'Reflex' engine

3−-- 'Reflex' engine

4module Reflex.Spider

7module Reflex.Spider

5 ( Spider

8 ( Spider

6 , SpiderTimeline

9 , SpiderTimeline

src/Reflex/Spider/Internal.hs+5−5

@@ -49,16 +49,16 @@ import Data.GADT.Compare

49import Data.IntMap.Strict (IntMap)

50import qualified Data.IntMap.Strict as IntMap

51import Data.IORef

52−import Data.Maybe

52+import Data.Maybe hiding (mapMaybe)

53import Data.Monoid ((<>))

54import Data.Proxy

55import Data.These

56import Data.Traversable

57+import Data.Witherable (Filterable, mapMaybe)

57import GHC.Exts

58import GHC.Exts

58import GHC.IORef (IORef (..))

59import GHC.IORef (IORef (..))

59import GHC.Stack

60import GHC.Stack

60import Reflex.FastWeak

61import Reflex.FastWeak

61−import Reflex.FunctorMaybe

62import System.IO.Unsafe

63import System.Mem.Weak

64import Unsafe.Coerce

@@ -1128,12 +1128,12 @@ newInvalidatorSwitch subd = return $! InvalidatorSwitch subd

1128newInvalidatorPull :: Pull x a -> IO (Invalidator x)

1129newInvalidatorPull p = return $! InvalidatorPull p

1130

1131−instance HasSpiderTimeline x => FunctorMaybe (Event x) where

1131+instance HasSpiderTimeline x => Filterable (Event x) where

1132− fmapMaybe f = push $ return . f

1132+ mapMaybe f = push $ return . f

1133

1134instance HasSpiderTimeline x => Align (Event x) where

1135 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]

1137

1138data DynType x p = UnsafeDyn !(BehaviorM x (PatchTarget p), Event x p)

1139 | BuildDyn !(EventM x (PatchTarget p), Event x p)

src/Reflex/Time.hs+113−13

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

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3+{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE DeriveTraversable #-}

3{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

5{-# LANGUAGE RecursiveDo #-}

7{-# LANGUAGE RecursiveDo #-}

@@ -9,6 +11,11 @@

9#ifdef USE_TEMPLATE_HASKELL

11#ifdef USE_TEMPLATE_HASKELL

10{-# LANGUAGE TemplateHaskell #-}

12{-# LANGUAGE TemplateHaskell #-}

11#endif

13#endif

14+-- |

15+-- Module:

16+-- Reflex.Time

17+-- Description:

18+-- Clocks, timers, and other time-related functions.

12module Reflex.Time where

19module Reflex.Time where

14import Reflex.Class

21import Reflex.Class

@@ -24,46 +31,50 @@ import Control.Monad

24import Control.Monad.Fix

31import Control.Monad.Fix

25import Control.Monad.IO.Class

32import Control.Monad.IO.Class

26import Data.Align

33import Data.Align

34+import Data.Data (Data)

27import Data.Fixed

35import Data.Fixed

36+import Data.Semigroup (Semigroup(..))

28import Data.Sequence (Seq, (|>))

37import Data.Sequence (Seq, (|>))

29import qualified Data.Sequence as Seq

38import qualified Data.Sequence as Seq

30import Data.These

39import Data.These

31import Data.Time.Clock

40import Data.Time.Clock

32import Data.Typeable

41import Data.Typeable

42+import GHC.Generics (Generic)

33import System.Random

43import System.Random

45+-- | Metadata associated with a timer "tick"

35data TickInfo

46data TickInfo

36 = TickInfo { _tickInfo_lastUTC :: UTCTime

47 = TickInfo { _tickInfo_lastUTC :: UTCTime

37 -- ^ UTC time immediately after the last tick.

48 -- ^ UTC time immediately after the last tick.

38 , _tickInfo_n :: Integer

49 , _tickInfo_n :: Integer

39− -- ^ Number of time periods since t0

50+ -- ^ Number of time periods or ticks since the start of the timer

40 , _tickInfo_alreadyElapsed :: NominalDiffTime

51 , _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.

42 }

53 }

43 deriving (Eq, Ord, Show, Typeable)

54 deriving (Eq, Ord, Show, Typeable)

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.

45−-- | Special case of 'tickLossyFrom' that uses the post-build event to start the

58+-- This is a special case of 'tickLossyFrom' that uses the post-build event to start the tick thread.

46−-- tick thread.

47tickLossy :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> UTCTime -> m (Event t TickInfo)

59tickLossy :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> UTCTime -> m (Event t TickInfo)

48tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild

60tickLossy dt t0 = tickLossyFrom dt t0 =<< getPostBuild

50−-- | Special case of 'tickLossyFrom' that uses the post-build event to start the

62+-- | Fires an 'Event' once every time provided interval elapses, approximately.

51−-- tick thread and the time of the post-build as the tick basis time.

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.

52tickLossyFromPostBuildTime :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> m (Event t TickInfo)

64tickLossyFromPostBuildTime :: (PostBuild t m, PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m) => NominalDiffTime -> m (Event t TickInfo)

53tickLossyFromPostBuildTime dt = do

65tickLossyFromPostBuildTime dt = do

54 postBuild <- getPostBuild

66 postBuild <- getPostBuild

55 postBuildTime <- performEvent $ liftIO getCurrentTime <$ postBuild

67 postBuildTime <- performEvent $ liftIO getCurrentTime <$ postBuild

56 tickLossyFrom' $ (dt,) <$> postBuildTime

68 tickLossyFrom' $ (dt,) <$> postBuildTime

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

70+-- | Fires an 'Event' approximately each time the provided interval elapses. 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

71+-- Each occurrence of the resulting event will contain the index of the current interval, with 0 representing the provided initial time.

61tickLossyFrom

72tickLossyFrom

62 :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)

73 :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)

63 => NominalDiffTime

74 => NominalDiffTime

64 -- ^ The length of a tick interval

75 -- ^ The length of a tick interval

65 -> UTCTime

76 -> 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.

67 -> Event t a

78 -> Event t a

68 -- ^ Event that starts a tick generation thread. Usually you want this to

79 -- ^ Event that starts a tick generation thread. Usually you want this to

69 -- be something like the result of getPostBuild that only fires once. But

80 -- be something like the result of getPostBuild that only fires once. But

@@ -71,12 +82,12 @@ tickLossyFrom

71 -> m (Event t TickInfo)

82 -> m (Event t TickInfo)

72tickLossyFrom dt t0 e = tickLossyFrom' $ (dt, t0) <$ e

83tickLossyFrom dt t0 e = tickLossyFrom' $ (dt, t0) <$ e

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'.

75tickLossyFrom'

86tickLossyFrom'

76 :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)

87 :: (PerformEvent t m, TriggerEvent t m, MonadIO (Performable m), MonadFix m)

77 => Event t (NominalDiffTime, UTCTime)

88 => Event t (NominalDiffTime, UTCTime)

78 -- ^ Event that starts a tick generation thread. Usually you want this to

89 -- ^ 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

80 -- there could be uses for starting multiple timer threads.

91 -- there could be uses for starting multiple timer threads.

81 -> m (Event t TickInfo)

92 -> m (Event t TickInfo)

82tickLossyFrom' e = do

93tickLossyFrom' e = do

@@ -87,12 +98,16 @@ tickLossyFrom' e = do

87 Concurrent.delay $ ceiling $ (fst pair - _tickInfo_alreadyElapsed tick) * 1000000

98 Concurrent.delay $ ceiling $ (fst pair - _tickInfo_alreadyElapsed tick) * 1000000

88 cb (tick, pair)

99 cb (tick, pair)

100

101+-- | Like 'tickLossy', but immediately calculates the first tick and provides a 'Dynamic' that is updated as ticks fire.

90clockLossy :: (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)

102clockLossy :: (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)

91clockLossy dt t0 = do

103clockLossy dt t0 = do

92 initial <- liftIO $ getCurrentTick dt t0

104 initial <- liftIO $ getCurrentTick dt t0

93 e <- tickLossy dt t0

105 e <- tickLossy dt t0

94 holdDyn initial e

106 holdDyn initial e

107

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.

96getCurrentTick :: NominalDiffTime -> UTCTime -> IO TickInfo

111getCurrentTick :: NominalDiffTime -> UTCTime -> IO TickInfo

97getCurrentTick dt t0 = do

112getCurrentTick dt t0 = do

98 t <- getCurrentTime

113 t <- getCurrentTime

@@ -266,6 +281,92 @@ throttle t e = do

266 delayed <- delay t outE

281 delayed <- delay t outE

267 return outE

282 return outE

268

283

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+

269#ifdef USE_TEMPLATE_HASKELL

370#ifdef USE_TEMPLATE_HASKELL

270makeLensesWith (lensRules & simpleLenses .~ True) ''TickInfo

371makeLensesWith (lensRules & simpleLenses .~ True) ''TickInfo

271#else

372#else

@@ -281,4 +382,3 @@ tickInfo_alreadyElapsed :: Lens' TickInfo NominalDiffTime

281tickInfo_alreadyElapsed f (TickInfo x1 x2 x3) = (\y -> TickInfo x1 x2 y) <$> f x3

382tickInfo_alreadyElapsed f (TickInfo x1 x2 x3) = (\y -> TickInfo x1 x2 y) <$> f x3

282{-# INLINE tickInfo_alreadyElapsed #-}

383{-# INLINE tickInfo_alreadyElapsed #-}

283#endif

384#endif

284−

src/Reflex/Workflow.hs+13−1

@@ -1,7 +1,13 @@

1{-# LANGUAGE RecursiveDo #-}

2{-# 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."

3module Reflex.Workflow (

10module Reflex.Workflow (

4− -- * Workflows

5 Workflow (..)

11 Workflow (..)

6 , workflow

12 , workflow

7 , workflowView

13 , workflowView

@@ -18,21 +24,27 @@ import Reflex.Network

18import Reflex.NotReady.Class

24import Reflex.NotReady.Class

19import Reflex.PostBuild.Class

25import Reflex.PostBuild.Class

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.

21newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }

29newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }

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).

23workflow :: forall t m a. (Reflex t, Adjustable t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)

32workflow :: forall t m a. (Reflex t, Adjustable t m, MonadFix m, MonadHold t m) => Workflow t m a -> m (Dynamic t a)

24workflow w0 = do

33workflow w0 = do

25 rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult

34 rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult

26 return $ fmap fst eResult

35 return $ fmap fst eResult

37+-- | Similar to 'workflow', but outputs an 'Event' that fires whenever the current 'Workflow' is replaced by the next 'Workflow'.

28workflowView :: 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)

38workflowView :: 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)

29workflowView w0 = do

39workflowView w0 = do

30 rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace

40 rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace

31 eReplace <- fmap switch $ hold never $ fmap snd eResult

41 eReplace <- fmap switch $ hold never $ fmap snd eResult

32 return $ fmap fst eResult

42 return $ fmap fst eResult

44+-- | Map a function over a 'Workflow', possibly changing the resturn type.

34mapWorkflow :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

45mapWorkflow :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

35mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)

46mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)

48+-- | Map a "cheap" function over a 'Workflow'. Refer to the documentation for 'pushCheap' for more information and performance considerations.

37mapWorkflowCheap :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

49mapWorkflowCheap :: (Reflex t, Functor m) => (a -> b) -> Workflow t m a -> Workflow t m b

38mapWorkflowCheap f (Workflow x) = Workflow (fmap (f *** fmapCheap (mapWorkflowCheap f)) x)

50mapWorkflowCheap f (Workflow x) = Workflow (fmap (f *** fmapCheap (mapWorkflowCheap f)) x)

test/RequesterT.hs+11−9

@@ -1,3 +1,4 @@

1+{-# LANGUAGE BangPatterns #-}

1{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE FlexibleContexts #-}

2{-# LANGUAGE GADTs #-}

3{-# LANGUAGE GADTs #-}

3{-# LANGUAGE RankNTypes #-}

4{-# LANGUAGE RankNTypes #-}

@@ -20,18 +21,19 @@ data RequestInt a where

21main :: IO ()

22main :: IO ()

22main = do

23main = do

23− os1@[[Just [10,9,8,7,6,5,4,3,2,1]]] <- runApp' (unwrapApp testOrdering) $

24+ os1 <- runApp' (unwrapApp testOrdering) $

24 [ Just ()

25 [ Just ()

25 ]

26 ]

26 print os1

27 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+ let ![[Just [10,9,8,7,6,5,4,3,2,1]]] = os1

28− <- runApp' (unwrapApp testSimultaneous) $ map Just $

29+ os2 <- runApp' (unwrapApp testSimultaneous) $ map Just $

29− [ This ()

30+ [ This ()

30− , That ()

31+ , That ()

31− , This ()

32+ , This ()

32− , These () ()

33+ , These () ()

33− ]

34+ ]

34 print os2

35 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

35 return ()

37 return ()

37unwrapRequest :: DSum tag RequestInt -> Int

39unwrapRequest :: DSum tag RequestInt -> Int

@@ -43,7 +45,7 @@ unwrapApp :: ( Reflex t, Monad m )

43 -> m (Event t [Int])

45 -> m (Event t [Int])

44unwrapApp x appIn = do

46unwrapApp x appIn = do

45 ((), e) <- runRequesterT (x appIn) never

47 ((), e) <- runRequesterT (x appIn) never

46− return $ fmap (map unwrapRequest . DMap.toList) e

48+ return $ fmap (map unwrapRequest . requesterDataToList) e

48testOrdering :: ( Response m ~ Identity

50testOrdering :: ( Response m ~ Identity

49 , Request m ~ RequestInt

51 , Request m ~ RequestInt