bbf9a05...develop · reflex

git.iko.soy/reflex

on develop help sign in

.github/workflows/haskell.ymlnew file+41

since splitsnapshots

unifiedsplit

@@ -0,0 +1,41 @@

1+name: github-action

3+on: [push, pull_request]

5+jobs:

6+ build:

7+ strategy:

8+ matrix:

9+ ghc: ['8.4.4', '8.6.5', '8.8.4', '8.10.2']

10+ os: ['ubuntu-latest', 'macos-latest']

11+ runs-on: ${{ matrix.os }}

12+

13+ name: GHC ${{ matrix.ghc }} on ${{ matrix.os }}

14+ steps:

15+ - uses: actions/checkout@v2

16+ - uses: actions/setup-haskell@v1

17+ with:

18+ ghc-version: ${{ matrix.ghc }}

19+ - name: Cache

20+ uses: actions/cache@v1

21+ env:

22+ cache-name: cache-cabal

23+ with:

24+ path: ~/.cabal

25+ key: ${{ runner.os }}-${{ matrix.ghc }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }}

26+ restore-keys: |

27+ ${{ runner.os }}-${{ matrix.ghc }}-build-${{ env.cache-name }}-

28+ ${{ runner.os }}-${{ matrix.ghc }}-build-

29+ ${{ runner.os }}-${{ matrix.ghc }}-

30+ ${{ runner.os }}

31+

32+ - name: Install dependencies

33+ run: |

34+ cabal update

35+ cabal build --only-dependencies --enable-tests --enable-benchmarks

36+ - name: Build

37+ run: cabal build --enable-tests --enable-benchmarks all

38+ - name: Run tests

39+ run: cabal test all

40+ - name: Build Docs

41+ run: cabal haddock

.travis.ymldeleted−177

@@ -1,177 +0,0 @@

1−# This Travis job script has been generated by a script via

2−#

3−# haskell-ci '--config=cabal.haskell-ci' 'cabal.project'

4−#

5−# For more information, see https://github.com/haskell-CI/haskell-ci

6−#

7−# version: 0.3.20190814

8−#

9−language: c

10−dist: xenial

11−sudo: required

12−git:

13− # whether to recursively clone submodules

14− submodules: false

15−cache:

16− directories:

17− - $HOME/.cabal/packages

18− - $HOME/.cabal/store

19−before_cache:

20− - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log

21− # remove files that are regenerated by 'cabal update'

22− - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*

23− - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json

24− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache

25− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar

26− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx

27− - rm -rfv $CABALHOME/packages/head.hackage

28−matrix:

29− include:

30− - compiler: ghcjs-8.4

31− addons: {"apt":{"sources":["hvr-ghc"],"packages":["cabal-install-3.0"]}}

32− - compiler: ghc-8.8.1

33− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}

34− - compiler: ghc-8.6.5

35− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}

36− - compiler: ghc-8.4.4

37− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}

38− - compiler: ghc-8.2.2

39− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}

40− - compiler: ghc-8.0.2

41− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}

42−before_install:

43− - |

44− if [ "$TRAVIS_OS_NAME" = "linux" ]; then

45− sudo add-apt-repository -y ppa:hvr/ghcjs;

46− curl -s https://deb.nodesource.com/gpgkey/nodesource.gpg.key | sudo apt-key add -

47− sudo apt-add-repository 'https://deb.nodesource.com/node_8.x xenial main'

48− sudo apt-get update;

49− sudo apt-get install $CC cabal-install-3.0 nodejs;

50− fi

51− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')

52− - WITHCOMPILER="-w $HC"

53− - |

54− if echo $CC | grep -q ghcjs; then

55− GHCJS=true

56− HC=${HC}js

57− WITHCOMPILER="--ghcjs ${WITHCOMPILER}js"

58− else

59− GHCJS=false;

60− fi

61− - if $GHCJS ; then sudo apt-get install -y ghc-8.4.4 ; fi

62− - if $GHCJS ; then PATH="/opt/ghc/8.4.4/bin:$PATH" ; fi

63− - HCPKG="$HC-pkg"

64− - unset CC

65− - CABAL=/opt/ghc/bin/cabal

66− - CABALHOME=$HOME/.cabal

67− - export PATH="$CABALHOME/bin:$PATH"

68− - TOP=$(pwd)

69− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"

70− - echo $HCNUMVER

71− - CABAL="$CABAL -vnormal+nowrap+markoutput"

72− - set -o pipefail

73− - |

74− echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk

75− echo 'BEGIN { state = "output"; }' >> .colorful.awk

76− echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk

77− echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk

78− echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk

79− echo ' if (state == "cabal") {' >> .colorful.awk

80− echo ' print blue($0)' >> .colorful.awk

81− echo ' } else {' >> .colorful.awk

82− echo ' print $0' >> .colorful.awk

83− echo ' }' >> .colorful.awk

84− echo '}' >> .colorful.awk

85− - cat .colorful.awk

86− - |

87− color_cabal_output () {

88− awk -f $TOP/.colorful.awk

89− }

90− - echo text | color_cabal_output

91−install:

92− - ${CABAL} --version

93− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

94− - node --version

95− - echo $GHCJS

96− - TEST=--enable-tests

97− - BENCH=--enable-benchmarks

98− - BENCH=--disable-benchmarks

99− - HEADHACKAGE=false

100− - rm -f $CABALHOME/config

101− - |

102− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config

103− echo "remote-build-reporting: anonymous" >> $CABALHOME/config

104− echo "write-ghc-environment-files: always" >> $CABALHOME/config

105− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config

106− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config

107− echo "world-file: $CABALHOME/world" >> $CABALHOME/config

108− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config

109− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config

110− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config

111− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config

112− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config

113− echo "install-dirs user" >> $CABALHOME/config

114− echo " prefix: $CABALHOME" >> $CABALHOME/config

115− echo "repository hackage.haskell.org" >> $CABALHOME/config

116− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config

117− - cat $CABALHOME/config

118− - rm -fv cabal.project cabal.project.local cabal.project.freeze

119− - travis_retry ${CABAL} v2-update -v

120− - if $GHCJS ; then (cd /tmp && ${CABAL} v2-install -w ghc-8.4.4 happy) ; fi

121− # Generate cabal.project

122− - rm -rf cabal.project cabal.project.local cabal.project.freeze

123− - touch cabal.project

124− - |

125− echo "packages: ." >> cabal.project

126− - |

127− - cat cabal.project || true

128− - cat cabal.project.local || true

129− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi

130− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output

131− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"

132− - rm cabal.project.freeze

133−script:

134− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

135− # Packaging...

136− - ${CABAL} v2-sdist all | color_cabal_output

137− # Unpacking...

138− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

139− - cd ${DISTDIR} || false

140− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;

141− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;

142− - PKGDIR_reflex="$(find . -maxdepth 1 -type d -regex '.*/reflex-[0-9.]*')"

143− # Generate cabal.project

144− - rm -rf cabal.project cabal.project.local cabal.project.freeze

145− - touch cabal.project

146− - |

147− echo "packages: ${PKGDIR_reflex}" >> cabal.project

148− - |

149− - cat cabal.project || true

150− - cat cabal.project.local || true

151− # Building...

152− # this builds all libraries and executables (without tests/benchmarks)

153− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output

154− # Building with tests and benchmarks...

155− # build & run tests, build benchmarks

156− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output

157− # Testing...

158− - if ! $GHCJS ; then ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi

159− # cabal check...

160− - (cd ${PKGDIR_reflex} && ${CABAL} -vnormal check)

161− # haddock...

162− - if ! $GHCJS ; then ${CABAL} v2-haddock $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi

163− # Constraint sets

164− - rm -rf cabal.project.local

165− # Constraint set no-th

166− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='reflex -use-template-haskell' all | color_cabal_output

167− # Constraint set old-these

168− - if $GHCJS || ! $GHCJS && [ $HCNUMVER -lt 80800 ] ; then ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='these <1' all | color_cabal_output ; fi

169− # Constraint set old-witherable

170− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='witherable <0.3.2' all | color_cabal_output

171− # Constraint set debug-propagation

172− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='reflex +debug-propagation' all | color_cabal_output

173− # Constraint set debug-cycles

174− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='reflex +debug-cycles' all | color_cabal_output

175−

176−# REGENDATA ["--config=cabal.haskell-ci","cabal.project"]

177−# EOF

ChangeLog.md+63−1

@@ -1,6 +1,63 @@

1# Revision history for reflex

3−## Unreleased

3+## 0.8.2.0

5+* Add `matchResponseMapWithRequests`, which it similar to `matchResponsesWithRequests` but allows processing of multiple responses at once.

7+## 0.8.1.1

9+* Allow newer hlint for older GHCs, and add upper bound for newer GHCs

10+

11+## 0.8.1.0

12+

13+* Add support for GHC 8.10

14+* Drop support for GHC < 8.4

15+

16+## 0.8.0.0

17+

18+* Replace 0.7.2.0 with 0.8.0.0 to reflect the `MonadHold` interface change. Deprecates 0.7.2.0.

19+

20+## 0.7.2.0 -- *Deprecated*

21+

22+* ([#416](https://github.com/reflex-frp/reflex/pull/416)) Add `now :: m (Event t ())` to `MonadHold`.

23+* Extend some dependency version bounds

24+* Fix HLint 3 test

25+

26+## 0.7.1.1

27+

28+*Backport release*.

29+Changes do not carry forward to 0.7.2.0.

30+

31+* Add support for GHC 8.10

32+* Drop support for GHC < 8.4

33+* Extend some dependency version bounds

34+* Fix HLint 3 test

35+

36+## 0.7.1.0

37+

38+* ([#413](https://github.com/reflex-frp/reflex/pull/413), [#417](https://github.com/reflex-frp/reflex/pull/417)) Add `Reflex.Host.Headless` module which provides `runHeadlessApp` as an easy way to run a Reflex network in a "headless" environment.

39+* ([#420](https://github.com/reflex-frp/reflex/pull/420)) Add a [`Data.Zip.Unzip`](https://hackage.haskell.org/package/semialign-1.1/docs/Data-Zip.html#t:Unzip) instance for `Event`.

40+* ([#419](https://github.com/reflex-frp/reflex/pull/419)) Add `distributeIntMapOverDynPure` and `joinDynThroughIntMap` as convenience functions for working with `Dynamic` `IntMap`s.

41+

42+

43+## 0.7.0.0

44+

45+* Add lifting instances for most classes to `Reflex.Profiled.Profiled`. ([#398](https://github.com/reflex-frp/reflex/pull/398))

46+* Class `MonadQuery t q m` now has a `Monad m` superclass constraint. ([#400](https://github.com/reflex-frp/reflex/pull/400))

47+* **(Breaking change)** Rename class `MonadBehaviorWriter` -> `BehaviorWriter` for consistency with `EventWriter`/`DynamicWriter`. ([#401](https://github.com/reflex-frp/reflex/pull/401))

48+* Introduce deprecated alias `MonadBehaviorWriter = BehaviorWriter`. ([#401](https://github.com/reflex-frp/reflex/pull/401))

49+* Fix bug in spider where event subscriptions would be prematurely finalized due to over-aggressive inlining. ([#409](https://github.com/reflex-frp/reflex/pull/409))

50+* Add instances of `PerformEvent` and `TriggerEvent` for `MaybeT`. ([#395](https://github.com/reflex-frp/reflex/pull/395))

51+

52+## 0.6.4.1

53+

54+* Fix a bug in the Reflex Profiled transformer where

55+ `Reflex.Class.mergeIncrementalG` and

56+ `Reflex.Class.mergeIncrementalWithMoveG` implementations referenced

57+ itself instead of the inner transformed timeline, causing an

58+ infinite loop.

59+

60+## 0.6.4

5* Support GHC 8.8

62* Support GHC 8.8

@@ -9,6 +66,11 @@

9* The `Reflex.Patch.*` modules were moved to the `patch` library.

66* The `Reflex.Patch.*` modules were moved to the `patch` library.

10 They are `Data.Patch.*` there, but reexported under their old names for backwards compatability here.

67 They are `Data.Patch.*` there, but reexported under their old names for backwards compatability here.

69+* Additional instances for `Query` classes for basic types.

70+

71+* Add cabal flags `debug-propagation` and `debug-event-cycles` to build in debugging

72+ code for performance and for cyclic dependencies between events

73+

12## 0.6.3

74## 0.6.3

14* `Data.WeakBag.traverse` and `Data.FastWeakBag.traverse` have been deprecated.

76* `Data.WeakBag.traverse` and `Data.FastWeakBag.traverse` have been deprecated.

Quickref.md+1

@@ -54,6 +54,7 @@ Since MonadHold depends on MonadSample, any [S] function also runs in [H] contex

54[ ] difference :: Event a -> Event b -> Event a

55[ ] align :: Event a -> Event b -> Event (These a b)

56[ ] alignWith :: (These a b -> c) -> Event a -> Event b -> Event c

57+ -- Note align functions from Data.Align in semialign package

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

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

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

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

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

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

README.md+15−17

@@ -1,25 +1,23 @@

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

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

3−[![Hackage](https://img.shields.io/hackage/v/reflex.svg)](http://hackage.haskell.org/package/reflex)

3+[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/reflex.svg)](https://hackage.haskell.org/package/reflex) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/reflex/badge)](https://matrix.hackage.haskell.org/#/package/reflex) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/reflex-frp/reflex/blob/master/LICENSE)

5−### Practical Functional Reactive Programming

5+Interactive programs without callbacks or side-effects. Functional Reactive Programming (FRP) uses composable events and time-varying values to describe interactive systems as pure functions. Just like other pure functional code, functional reactive code is easier to get right on the first try, maintain, and reuse.

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

7+Reflex is a fully-deterministic, higher-order Functional Reactive Programming interface and an engine that efficiently implements that interface.

9−[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.

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

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

11+## Resources

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

13+* [Official Website](https://reflex-frp.org)

14+* [Quick Reference](Quickref.md)

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

16+* [Obelisk](https://github.com/obsidiansystems/obelisk#obelisk): A framework built on Reflex and Reflex-DOM for functional reactive web and mobile applications, with batteries included.

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

18+* [/r/reflexfrp](https://www.reddit.com/r/reflexfrp)

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

15−### Resources

21+## Hacking

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

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

23+From the root of a [Reflex Platform](https://github.com/reflex-frp/reflex-platform) checkout, run `./scripts/hack-on haskell-overlays/reflex-packages/dep/reflex`. This will check out the reflex source code into the `haskell-overlays/reflex-packages/dep/reflex` directory. You can then point that checkout at your fork, make changes, etc. Use the `./try-reflex` or `./scripts/work-on` scripts to start a shell in which you can test your changes.

19−

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

21−

22−### Hacking

23−

24−Use the `./scripts/hack-on 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.

25−Then do modifications to the source in place, and use the `./try-reflex` or `./scripts/work-on` scripts to create the shell to test your changes.

cabal.project.freezedeleted−2

@@ -1,2 +0,0 @@

1−constraints: any.text < 1.2.4.0

2− , hlint < 2.2.6 || > 2.2.6

reflex.cabal+66−22

@@ -1,7 +1,17 @@

1Name: reflex

2−Version: 0.6.3

2+Version: 0.8.2.0

3Synopsis: Higher-order Functional Reactive Programming

4+Description:

5+ Interactive programs without callbacks or side-effects.

6+ Functional Reactive Programming (FRP) uses composable events and time-varying

7+ values to describe interactive systems as pure functions.

8+ Just like other pure functional code, functional reactive code is easier

9+ to get right on the first try, maintain, and reuse.

10+ .

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

11+ Reflex is a fully-deterministic, higher-order Functional Reactive Programming

12+ interface and an engine that efficiently implements that interface.

13+ .

14+ <https://reflex-frp.org>

5License: BSD3

15License: BSD3

6License-file: LICENSE

16License-file: LICENSE

7Author: Ryan Trinkle

17Author: Ryan Trinkle

@@ -18,8 +28,8 @@ extra-source-files:

18 ChangeLog.md

28 ChangeLog.md

20tested-with:

30tested-with:

21− GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1,

31+ GHC ==8.4.4 || ==8.6.5 || ==8.8.1 || ==8.10.2,

22− GHCJS ==8.4

32+ GHCJS ==8.6

24flag use-reflex-optimizer

34flag use-reflex-optimizer

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

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

@@ -61,21 +71,23 @@ library

61 hs-source-dirs: src

71 hs-source-dirs: src

62 build-depends:

72 build-depends:

63 MemoTrie == 0.6.*,

73 MemoTrie == 0.6.*,

64− base >= 4.9 && < 4.14,

74+ base >= 4.11 && < 4.15,

65 bifunctors >= 5.2 && < 5.6,

75 bifunctors >= 5.2 && < 5.6,

66 comonad >= 5.0.4 && < 5.1,

76 comonad >= 5.0.4 && < 5.1,

77+ constraints >= 0.10 && <0.14,

67 constraints-extras >= 0.3 && < 0.4,

78 constraints-extras >= 0.3 && < 0.4,

68 containers >= 0.6 && < 0.7,

79 containers >= 0.6 && < 0.7,

69 data-default >= 0.5 && < 0.8,

80 data-default >= 0.5 && < 0.8,

70− dependent-map >= 0.3 && < 0.4,

81+ dependent-map >= 0.3 && < 0.5,

71 exception-transformers == 0.4.*,

82 exception-transformers == 0.4.*,

72 lens >= 4.7 && < 5,

83 lens >= 4.7 && < 5,

84+ mmorph >= 1.0 && < 1.2,

73 monad-control >= 1.0.1 && < 1.1,

85 monad-control >= 1.0.1 && < 1.1,

74 mtl >= 2.1 && < 2.3,

86 mtl >= 2.1 && < 2.3,

75− patch >= 0.0 && < 0.1,

87+ patch >= 0.0.1 && < 0.1,

76− prim-uniq >= 0.1.0.1 && < 0.2,

88+ prim-uniq >= 0.1.0.1 && < 0.3,

77 primitive >= 0.5 && < 0.8,

89 primitive >= 0.5 && < 0.8,

78− profunctors >= 5.3 && < 5.6,

90+ profunctors >= 5.3 && < 5.7,

79 random == 1.1.*,

91 random == 1.1.*,

80 ref-tf == 0.4.*,

92 ref-tf == 0.4.*,

81 reflection == 2.1.*,

93 reflection == 2.1.*,

@@ -85,10 +97,10 @@ library

85 time >= 1.4 && < 1.10,

97 time >= 1.4 && < 1.10,

86 transformers >= 0.5.6.0 && < 0.6,

98 transformers >= 0.5.6.0 && < 0.6,

87 unbounded-delays >= 0.1.0.0 && < 0.2,

99 unbounded-delays >= 0.1.0.0 && < 0.2,

88− witherable >= 0.3 && < 0.3.2

100+ witherable >= 0.3 && < 0.5

101

90 if flag(split-these)

102 if flag(split-these)

91− build-depends: these >= 1 && <1.1,

103+ build-depends: these >= 1 && <1.2,

92 semialign >=1 && <1.2,

104 semialign >=1 && <1.2,

93 monoidal-containers >= 0.6 && < 0.7

105 monoidal-containers >= 0.6 && < 0.7

94 else

106 else

@@ -119,6 +131,7 @@ library

119 Reflex.FastWeak,

131 Reflex.FastWeak,

120 Reflex.FunctorMaybe,

132 Reflex.FunctorMaybe,

121 Reflex.Host.Class,

133 Reflex.Host.Class,

134+ Reflex.Host.Headless,

122 Reflex.Network,

135 Reflex.Network,

123 Reflex.NotReady.Class,

136 Reflex.NotReady.Class,

124 Reflex.PerformEvent.Base,

137 Reflex.PerformEvent.Base,

@@ -153,7 +166,8 @@ library

153

166

154 if flag(debug-trace-events)

167 if flag(debug-trace-events)

155 cpp-options: -DDEBUG_TRACE_EVENTS

168 cpp-options: -DDEBUG_TRACE_EVENTS

156− build-depends: bytestring

169+ build-depends:

170+ bytestring >= 0.10.8 && < 0.11

157

171

158 if flag(use-reflex-optimizer)

172 if flag(use-reflex-optimizer)

159 cpp-options: -DUSE_REFLEX_OPTIMIZER

173 cpp-options: -DUSE_REFLEX_OPTIMIZER

@@ -161,7 +175,7 @@ library

161 exposed-modules: Reflex.Optimizer

175 exposed-modules: Reflex.Optimizer

162

176

163 if flag(debug-propagation)

177 if flag(debug-propagation)

164− cpp-options: -DDEBUG

178+ cpp-options: -DDEBUG -DDEBUG_TRACE_PROPAGATION -DDEBUG_TRACE_INVALIDATION

165

179

166 if flag(debug-cycles)

180 if flag(debug-cycles)

167 cpp-options: -DDEBUG_CYCLES

181 cpp-options: -DDEBUG_CYCLES

@@ -169,22 +183,23 @@ library

169 if flag(use-template-haskell)

183 if flag(use-template-haskell)

170 cpp-options: -DUSE_TEMPLATE_HASKELL

184 cpp-options: -DUSE_TEMPLATE_HASKELL

171 build-depends:

185 build-depends:

172− dependent-sum >= 0.6 && < 0.7,

186+ dependent-sum >= 0.6 && < 0.8,

173− haskell-src-exts >= 1.16 && < 1.23,

187+ haskell-src-exts >= 1.16 && < 1.24,

174 haskell-src-meta >= 0.6 && < 0.9,

188 haskell-src-meta >= 0.6 && < 0.9,

175− template-haskell >= 2.9 && < 2.16

189+ template-haskell >= 2.9 && < 2.17

176 exposed-modules:

190 exposed-modules:

177 Reflex.Dynamic.TH

191 Reflex.Dynamic.TH

178 other-extensions: TemplateHaskell

192 other-extensions: TemplateHaskell

179 else

193 else

180 build-depends:

194 build-depends:

181− dependent-sum >= 0.6 && < 0.7

195+ dependent-sum >= 0.6 && < 0.8

182

196

183 if flag(fast-weak) && impl(ghcjs)

197 if flag(fast-weak) && impl(ghcjs)

184 cpp-options: -DGHCJS_FAST_WEAK

198 cpp-options: -DGHCJS_FAST_WEAK

185

199

186 if impl(ghcjs)

200 if impl(ghcjs)

187− build-depends: ghcjs-base

201+ build-depends:

202+ ghcjs-base == 0.2.*

188

203

189test-suite semantics

204test-suite semantics

190 default-language: Haskell2010

205 default-language: Haskell2010

@@ -243,7 +258,10 @@ test-suite hlint

243 , directory

258 , directory

244 , filepath

259 , filepath

245 , filemanip

260 , filemanip

246− , hlint < 2.1 || >= 2.2.2

261+ if impl(ghc >= 8.8)

262+ build-depends: hlint >= 3 && < 4

263+ else

264+ build-depends: hlint (< 2.1 || >= 2.2.2) && < 4

247 if impl(ghcjs)

265 if impl(ghcjs)

248 buildable: False

266 buildable: False

249

267

@@ -306,16 +324,19 @@ test-suite RequesterT

306 main-is: RequesterT.hs

324 main-is: RequesterT.hs

307 hs-source-dirs: test

325 hs-source-dirs: test

308 build-depends: base

326 build-depends: base

327+ , constraints

328+ , constraints-extras

309 , containers

329 , containers

310 , deepseq

330 , deepseq

311− , dependent-sum

312 , dependent-map

331 , dependent-map

332+ , dependent-sum

313 , lens

333 , lens

314 , mtl

334 , mtl

335+ , ref-tf

336+ , reflex

337+ , text

315 , these

338 , these

316 , transformers

339 , transformers

317− , reflex

318− , ref-tf

319

340

320 if flag(split-these)

341 if flag(split-these)

321 build-depends: these-lens

342 build-depends: these-lens

@@ -325,6 +346,29 @@ test-suite RequesterT

325 Reflex.Plan.Pure

346 Reflex.Plan.Pure

326 Test.Run

347 Test.Run

327

348

349+test-suite Headless

350+ default-language: Haskell2010

351+ type: exitcode-stdio-1.0

352+ main-is: Headless.hs

353+ hs-source-dirs: test

354+ build-depends: base

355+ , reflex

356+

357+test-suite Adjustable

358+ default-language: Haskell2010

359+ type: exitcode-stdio-1.0

360+ main-is: Adjustable.hs

361+ hs-source-dirs: test

362+ build-depends: base

363+ , containers

364+ , dependent-sum

365+ , reflex

366+ , ref-tf

367+ , these

368+

369+ other-modules:

370+ Test.Run

371+

328test-suite QueryT

372test-suite QueryT

329 default-language: Haskell2010

373 default-language: Haskell2010

330 type: exitcode-stdio-1.0

374 type: exitcode-stdio-1.0

release.nix+2−2

@@ -1,12 +1,12 @@

1{ reflex-platform-fun ? import ./dep/reflex-platform

2+, supportedSystems ? ["x86_64-linux" "x86_64-darwin"]

2}:

3}:

4let

5let

5 native-reflex-platform = reflex-platform-fun {};

6 native-reflex-platform = reflex-platform-fun {};

6 inherit (native-reflex-platform.nixpkgs) lib;

7 inherit (native-reflex-platform.nixpkgs) lib;

7− systems = ["x86_64-linux" "x86_64-darwin"];

9− perPlatform = lib.genAttrs systems (system: let

9+ perPlatform = lib.genAttrs supportedSystems (system: let

10 reflex-platform = reflex-platform-fun { inherit system; };

11 compilers = [

12 "ghc"

src/Reflex/Adjustable/Class.hs+2−1

@@ -30,7 +30,8 @@ module Reflex.Adjustable.Class

31import Control.Monad.Identity

32import Control.Monad.Reader

33−import Data.Dependent.Map (DMap, GCompare (..))

33+import Data.Dependent.Map (DMap)

34+import Data.GADT.Compare (GCompare(..))

34import qualified Data.Dependent.Map as DMap

35import qualified Data.Dependent.Map as DMap

35import Data.Functor.Constant

36import Data.Functor.Constant

36import Data.Functor.Misc

37import Data.Functor.Misc

src/Reflex/BehaviorWriter/Base.hs+16−7

@@ -1,6 +1,6 @@

1{-|

2Module: Reflex.BehaviorWriter.Base

3−Description: Implementation of MonadBehaviorWriter

3+Description: Implementation of BehaviorWriter

4-}

5{-# LANGUAGE CPP #-}

6{-# LANGUAGE FlexibleInstances #-}

@@ -24,6 +24,7 @@ module Reflex.BehaviorWriter.Base

24import Control.Monad.Exception

25import Control.Monad.Identity

26import Control.Monad.IO.Class

27+import Control.Monad.Morph

27import Control.Monad.Reader

28import Control.Monad.Reader

28import Control.Monad.Ref

29import Control.Monad.Ref

29import Control.Monad.State.Strict

30import Control.Monad.State.Strict

@@ -46,9 +47,20 @@ import Reflex.Query.Class

46import Reflex.Requester.Class

47import Reflex.Requester.Class

47import Reflex.TriggerEvent.Class

48import Reflex.TriggerEvent.Class

49−-- | A basic implementation of 'MonadBehaviorWriter'.

50+-- | A basic implementation of 'BehaviorWriter'.

50newtype BehaviorWriterT t w m a = BehaviorWriterT { unBehaviorWriterT :: StateT [Behavior t w] m a }

51newtype BehaviorWriterT t w m a = BehaviorWriterT { unBehaviorWriterT :: StateT [Behavior t w] m a }

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

52+ -- The list is kept in reverse order

53+ deriving

54+ ( Functor

55+ , Applicative

56+ , Monad

57+ , MonadTrans

58+ , MFunctor

59+ , MonadIO

60+ , MonadFix

61+ , MonadAsyncException

62+ , MonadException

63+ )

53-- | Run a 'BehaviorWriterT' action. The behavior writer output will be provided

65-- | Run a 'BehaviorWriterT' action. The behavior writer output will be provided

54-- along with the result of the action.

66-- along with the result of the action.

@@ -73,9 +85,6 @@ withBehaviorWriterT f dw = do

73deriving instance MonadHold t m => MonadHold t (BehaviorWriterT t w m)

85deriving instance MonadHold t m => MonadHold t (BehaviorWriterT t w m)

74deriving instance MonadSample t m => MonadSample t (BehaviorWriterT t w m)

86deriving instance MonadSample t m => MonadSample t (BehaviorWriterT t w m)

76−instance MonadTrans (BehaviorWriterT t w) where

77− lift = BehaviorWriterT . lift

78−

79instance MonadRef m => MonadRef (BehaviorWriterT t w m) where

88instance MonadRef m => MonadRef (BehaviorWriterT t w m) where

80 type Ref (BehaviorWriterT t w m) = Ref m

89 type Ref (BehaviorWriterT t w m) = Ref m

81 newRef = lift . newRef

90 newRef = lift . newRef

@@ -89,7 +98,7 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (BehaviorWri

89 newEventWithTrigger = lift . newEventWithTrigger

98 newEventWithTrigger = lift . newEventWithTrigger

90 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

99 newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

100

92−instance (Monad m, Monoid w, Reflex t) => MonadBehaviorWriter t w (BehaviorWriterT t w m) where

101+instance (Monad m, Monoid w, Reflex t) => BehaviorWriter t w (BehaviorWriterT t w m) where

93 tellBehavior w = BehaviorWriterT $ modify (w :)

102 tellBehavior w = BehaviorWriterT $ modify (w :)

103

95instance MonadReader r m => MonadReader r (BehaviorWriterT t w m) where

104instance MonadReader r m => MonadReader r (BehaviorWriterT t w m) where

src/Reflex/BehaviorWriter/Class.hs+11−5

@@ -1,8 +1,9 @@

1{-|

2Module: Reflex.BehaviorWriter.Class

3−Description: This module defines the 'MonadBehaviorWriter' class

3+Description: This module defines the 'BehaviorWriter' class

4-}

5{-# LANGUAGE CPP #-}

6+{-# LANGUAGE ConstraintKinds #-}

6{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FlexibleInstances #-}

7{-# LANGUAGE FunctionalDependencies #-}

8{-# LANGUAGE FunctionalDependencies #-}

8{-# LANGUAGE UndecidableInstances #-}

9{-# LANGUAGE UndecidableInstances #-}

@@ -10,16 +11,21 @@ Description: This module defines the 'MonadBehaviorWriter' class

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

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

11#endif

12#endif

12module Reflex.BehaviorWriter.Class

13module Reflex.BehaviorWriter.Class

13− ( MonadBehaviorWriter (..)

14+ ( MonadBehaviorWriter

15+ , BehaviorWriter(..)

14 ) where

16 ) where

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

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

17import Reflex.Class (Behavior)

19import Reflex.Class (Behavior)

21+{-# DEPRECATED MonadBehaviorWriter "Use 'BehaviorWriter' instead" #-}

22+-- | Type synonym for 'BehaviorWriter'

23+type MonadBehaviorWriter = BehaviorWriter

24+

19−-- | 'MonadBehaviorWriter' efficiently collects 'Behavior' values using 'tellBehavior'

25+-- | 'BehaviorWriter' efficiently collects 'Behavior' values using 'tellBehavior'

20-- and combines them monoidally to provide a 'Behavior' result.

26-- and combines them monoidally to provide a 'Behavior' result.

21−class (Monad m, Monoid w) => MonadBehaviorWriter t w m | m -> t w where

27+class (Monad m, Monoid w) => BehaviorWriter t w m | m -> t w where

22 tellBehavior :: Behavior t w -> m ()

28 tellBehavior :: Behavior t w -> m ()

24−instance MonadBehaviorWriter t w m => MonadBehaviorWriter t w (ReaderT r m) where

30+instance BehaviorWriter t w m => BehaviorWriter t w (ReaderT r m) where

25 tellBehavior = lift . tellBehavior

31 tellBehavior = lift . tellBehavior

src/Reflex/Class.hs+23−3

@@ -180,7 +180,7 @@ import Prelude hiding (zip, zipWith)

180import Data.These.Combinators (justThese)

181#endif

182#if MIN_VERSION_semialign(1,1,0)

183−import Data.Zip (Zip (..))

183+import Data.Zip (Zip (..), Unzip (..))

184#endif

185#endif

186

@@ -196,7 +196,8 @@ import Data.Align

196import Data.Bifunctor

197import Data.Coerce

198import Data.Default

199−import Data.Dependent.Map (DMap, DSum (..))

199+import Data.Dependent.Map (DMap)

200+import Data.Dependent.Sum (DSum (..))

200import qualified Data.Dependent.Map as DMap

201import qualified Data.Dependent.Map as DMap

201import Data.Functor.Compose

202import Data.Functor.Compose

202import Data.Functor.Product

203import Data.Functor.Product

@@ -210,7 +211,7 @@ import Data.IntMap.Strict (IntMap)

210import qualified Data.IntMap.Strict as IntMap

211import qualified Data.IntMap.Strict as IntMap

211import Data.List.NonEmpty (NonEmpty (..))

212import Data.List.NonEmpty (NonEmpty (..))

212import Data.Map (Map)

213import Data.Map (Map)

213−import Data.Semigroup (Semigroup, sconcat, stimes, (<>))

214+import Data.Semigroup (Semigroup (..))

214import Data.Some (Some(Some))

215import Data.Some (Some(Some))

215import Data.String

216import Data.String

216import Data.These

217import Data.These

@@ -420,6 +421,13 @@ class MonadSample t m => MonadHold t m where

420 -- | Create a new 'Event' that only occurs only once, on the first occurrence of

421 -- | Create a new 'Event' that only occurs only once, on the first occurrence of

421 -- the supplied 'Event'.

422 -- the supplied 'Event'.

422 headE :: Event t a -> m (Event t a)

423 headE :: Event t a -> m (Event t a)

424+ -- | An event which only occurs at the current moment in time, such that:

425+ --

426+ -- > coincidence (pushAlways (\a -> (a <$) <$> now) e) = e

427+ --

428+ now :: m (Event t ())

429+ default now :: (m ~ f m', MonadTrans f, MonadHold t m') => m (Event t ())

430+ now = lift now

423

431

424-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',

432-- | Accumulate an 'Incremental' with the supplied initial value and the firings of the provided 'Event',

425-- using the combining function to produce a patch.

433-- using the combining function to produce a patch.

@@ -565,6 +573,7 @@ instance MonadHold t m => MonadHold t (ReaderT r m) where

565 holdIncremental a0 = lift . holdIncremental a0

573 holdIncremental a0 = lift . holdIncremental a0

566 buildDynamic a0 = lift . buildDynamic a0

574 buildDynamic a0 = lift . buildDynamic a0

567 headE = lift . headE

575 headE = lift . headE

576+ now = lift now

568

577

569instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where

578instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where

570 sample = lift . sample

579 sample = lift . sample

@@ -575,6 +584,7 @@ instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where

575 holdIncremental a0 = lift . holdIncremental a0

584 holdIncremental a0 = lift . holdIncremental a0

576 buildDynamic a0 = lift . buildDynamic a0

585 buildDynamic a0 = lift . buildDynamic a0

577 headE = lift . headE

586 headE = lift . headE

587+ now = lift now

578

588

579instance MonadSample t m => MonadSample t (StateT s m) where

589instance MonadSample t m => MonadSample t (StateT s m) where

580 sample = lift . sample

590 sample = lift . sample

@@ -585,6 +595,7 @@ instance MonadHold t m => MonadHold t (StateT s m) where

585 holdIncremental a0 = lift . holdIncremental a0

595 holdIncremental a0 = lift . holdIncremental a0

586 buildDynamic a0 = lift . buildDynamic a0

596 buildDynamic a0 = lift . buildDynamic a0

587 headE = lift . headE

597 headE = lift . headE

598+ now = lift now

588

599

589instance MonadSample t m => MonadSample t (ExceptT e m) where

600instance MonadSample t m => MonadSample t (ExceptT e m) where

590 sample = lift . sample

601 sample = lift . sample

@@ -595,6 +606,7 @@ instance MonadHold t m => MonadHold t (ExceptT e m) where

595 holdIncremental a0 = lift . holdIncremental a0

606 holdIncremental a0 = lift . holdIncremental a0

596 buildDynamic a0 = lift . buildDynamic a0

607 buildDynamic a0 = lift . buildDynamic a0

597 headE = lift . headE

608 headE = lift . headE

609+ now = lift now

598

610

599instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where

611instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where

600 sample = lift . sample

612 sample = lift . sample

@@ -605,6 +617,7 @@ instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where

605 holdIncremental a0 = lift . holdIncremental a0

617 holdIncremental a0 = lift . holdIncremental a0

606 buildDynamic a0 = lift . buildDynamic a0

618 buildDynamic a0 = lift . buildDynamic a0

607 headE = lift . headE

619 headE = lift . headE

620+ now = lift now

608

621

609instance MonadSample t m => MonadSample t (ContT r m) where

622instance MonadSample t m => MonadSample t (ContT r m) where

610 sample = lift . sample

623 sample = lift . sample

@@ -615,6 +628,7 @@ instance MonadHold t m => MonadHold t (ContT r m) where

615 holdIncremental a0 = lift . holdIncremental a0

628 holdIncremental a0 = lift . holdIncremental a0

616 buildDynamic a0 = lift . buildDynamic a0

629 buildDynamic a0 = lift . buildDynamic a0

617 headE = lift . headE

630 headE = lift . headE

631+ now = lift now

618

632

619--------------------------------------------------------------------------------

633--------------------------------------------------------------------------------

620-- Convenience functions

634-- Convenience functions

@@ -1091,6 +1105,12 @@ instance Reflex t => Zip (Event t) where

1091 zip x y = mapMaybe justThese $ align x y

1105 zip x y = mapMaybe justThese $ align x y

1092#endif

1106#endif

1093

1107

1108+#ifdef MIN_VERSION_semialign

1109+#if MIN_VERSION_semialign(1,1,0)

1110+instance Reflex t => Unzip (Event t) where

1111+ unzip = splitE

1112+#endif

1113+#endif

1094

1114

1095-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and

1115-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and

1096-- the 'Behavior' is true at the time of occurrence.

1116-- the 'Behavior' is true at the time of occurrence.

src/Reflex/Dynamic.hs+15−1

@@ -53,10 +53,12 @@ module Reflex.Dynamic

53 , foldDynMaybe

54 , foldDynMaybeM

55 , joinDynThroughMap

56+ , joinDynThroughIntMap

56 , traceDyn

57 , traceDyn

57 , traceDynWith

58 , traceDynWith

58 , splitDynPure

59 , splitDynPure

59 , distributeMapOverDynPure

60 , distributeMapOverDynPure

61+ , distributeIntMapOverDynPure

60 , distributeDMapOverDynPure

62 , distributeDMapOverDynPure

61 , distributeListOverDynPure

63 , distributeListOverDynPure

62 , Demux

64 , Demux

@@ -88,6 +90,8 @@ import Data.Dependent.Map (DMap)

88import qualified Data.Dependent.Map as DMap

90import qualified Data.Dependent.Map as DMap

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

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

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

92import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))

93+import Data.IntMap (IntMap)

94+import qualified Data.IntMap as IntMap

91import Data.Map (Map)

95import Data.Map (Map)

92import Data.Maybe

96import Data.Maybe

93import Data.Monoid ((<>))

97import Data.Monoid ((<>))

@@ -202,6 +206,11 @@ splitDynPure d = (fmap fst d, fmap snd d)

202distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)

206distributeMapOverDynPure :: (Reflex t, Ord k) => Map k (Dynamic t v) -> Dynamic t (Map k v)

203distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap

207distributeMapOverDynPure = fmap dmapToMap . distributeDMapOverDynPure . mapWithFunctorToDMap

204

208

209+-- | Convert an 'IntMap' with 'Dynamic' elements into a 'Dynamic' of an 'IntMap' with

210+-- non-'Dynamic' elements.

211+distributeIntMapOverDynPure :: (Reflex t) => IntMap (Dynamic t v) -> Dynamic t (IntMap v)

212+distributeIntMapOverDynPure = fmap dmapToIntMap . distributeDMapOverDynPure . intMapWithFunctorToDMap

213+

205-- | Convert a list with 'Dynamic' elements into a 'Dynamic' of a list with

214-- | Convert a list with 'Dynamic' elements into a 'Dynamic' of a list with

206-- non-'Dynamic' elements, preserving the order of the elements.

215-- non-'Dynamic' elements, preserving the order of the elements.

207{-# DEPRECATED distributeListOverDynPure "Use 'distributeListOverDyn' instead" #-}

216{-# DEPRECATED distributeListOverDynPure "Use 'distributeListOverDyn' instead" #-}

@@ -214,6 +223,11 @@ distributeListOverDynPure = distributeListOverDyn

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

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

215joinDynThroughMap = (distributeMapOverDynPure =<<)

224joinDynThroughMap = (distributeMapOverDynPure =<<)

216

225

226+-- | Combine a 'Dynamic' of an 'IntMap' of 'Dynamic's into a 'Dynamic'

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

228+joinDynThroughIntMap :: forall t a. (Reflex t) => Dynamic t (IntMap (Dynamic t a)) -> Dynamic t (IntMap a)

229+joinDynThroughIntMap = (distributeIntMapOverDynPure =<<)

230+

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

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

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

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

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

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

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

334--

348--

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

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

336--

350--

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

351+-- However, when 'demuxed' is used multiple times, the complexity is only

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

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

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

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

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

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

src/Reflex/DynamicWriter/Base.hs+13−4

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

25import Control.Monad.Primitive

26import Control.Monad.Primitive

26import Control.Monad.Reader

27import Control.Monad.Reader

27import Control.Monad.Ref

28import Control.Monad.Ref

@@ -51,9 +52,6 @@ import Reflex.Query.Class

51import Reflex.Requester.Class

52import Reflex.Requester.Class

52import Reflex.TriggerEvent.Class

53import Reflex.TriggerEvent.Class

54−instance MonadTrans (DynamicWriterT t w) where

55− lift = DynamicWriterT . lift

56−

57mapIncrementalMapValues :: (Reflex t, Patch (p v), Patch (p v'), PatchTarget (p v) ~ f v, PatchTarget (p v') ~ f v', Functor p, Functor f) => (v -> v') -> Incremental t (p v) -> Incremental t (p v')

55mapIncrementalMapValues :: (Reflex t, Patch (p v), Patch (p v'), PatchTarget (p v) ~ f v, PatchTarget (p v') ~ f v', Functor p, Functor f) => (v -> v') -> Incremental t (p v) -> Incremental t (p v')

58mapIncrementalMapValues f = unsafeMapIncremental (fmap f) (fmap f)

56mapIncrementalMapValues f = unsafeMapIncremental (fmap f) (fmap f)

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

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

89-- | A basic implementation of 'DynamicWriter'.

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

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

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

91+ -- The list is kept in reverse order

92+ deriving

93+ ( Functor

94+ , Applicative

95+ , Monad

96+ , MonadTrans

97+ , MFunctor

98+ , MonadIO

99+ , MonadFix

100+ , MonadAsyncException

101+ , MonadException

102+ )

103

95deriving instance MonadHold t m => MonadHold t (DynamicWriterT t w m)

104deriving instance MonadHold t m => MonadHold t (DynamicWriterT t w m)

96deriving instance MonadSample t m => MonadSample t (DynamicWriterT t w m)

105deriving instance MonadSample t m => MonadSample t (DynamicWriterT t w m)

src/Reflex/EventWriter/Base.hs+16−5

@@ -35,12 +35,14 @@ import Reflex.TriggerEvent.Class

36import Control.Monad.Exception

37import Control.Monad.Identity

38+import Control.Monad.Morph

38import Control.Monad.Primitive

39import Control.Monad.Primitive

39import Control.Monad.Reader

40import Control.Monad.Reader

40import Control.Monad.Ref

41import Control.Monad.Ref

41import Control.Monad.State.Strict

42import Control.Monad.State.Strict

42−import Data.Dependent.Map (DMap, DSum (..))

43+import Data.Dependent.Map (DMap)

43import qualified Data.Dependent.Map as DMap

44import qualified Data.Dependent.Map as DMap

45+import Data.Dependent.Sum (DSum (..))

44import Data.Functor.Compose

46import Data.Functor.Compose

45import Data.Functor.Misc

47import Data.Functor.Misc

46import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))

48import Data.GADT.Compare (GCompare (..), GEq (..), GOrdering (..))

@@ -96,7 +98,17 @@ data EventWriterState t w = EventWriterState

97-- | A basic implementation of 'EventWriter'.

99-- | A basic implementation of 'EventWriter'.

98newtype EventWriterT t w m a = EventWriterT { unEventWriterT :: StateT (EventWriterState t w) m a }

100newtype EventWriterT t w m a = EventWriterT { unEventWriterT :: StateT (EventWriterState t w) m a }

99− deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)

101+ deriving

102+ ( Functor

103+ , Applicative

104+ , Monad

105+ , MonadTrans

106+ , MFunctor

107+ , MonadFix

108+ , MonadIO

109+ , MonadException

110+ , MonadAsyncException

111+ )

100

112

101-- | Run a 'EventWriterT' action.

113-- | Run a 'EventWriterT' action.

102runEventWriterT :: forall t m w a. (Reflex t, Monad m, Semigroup w) => EventWriterT t w m a -> m (a, Event t w)

114runEventWriterT :: forall t m w a. (Reflex t, Monad m, Semigroup w) => EventWriterT t w m a -> m (a, Event t w)

@@ -116,9 +128,6 @@ instance (Reflex t, Monad m, Semigroup w) => EventWriter t w (EventWriterT t w m

116 , _eventWriterState_told = (tellId myId :=> w) : _eventWriterState_told old

128 , _eventWriterState_told = (tellId myId :=> w) : _eventWriterState_told old

117 }

129 }

118

130

119−instance MonadTrans (EventWriterT t w) where

120− lift = EventWriterT . lift

121−

122instance MonadSample t m => MonadSample t (EventWriterT t w m) where

131instance MonadSample t m => MonadSample t (EventWriterT t w m) where

123 sample = lift . sample

132 sample = lift . sample

124

133

@@ -133,6 +142,8 @@ instance MonadHold t m => MonadHold t (EventWriterT t w m) where

133 buildDynamic a0 = lift . buildDynamic a0

142 buildDynamic a0 = lift . buildDynamic a0

134 {-# INLINABLE headE #-}

143 {-# INLINABLE headE #-}

135 headE = lift . headE

144 headE = lift . headE

145+ {-# INLINABLE now #-}

146+ now = lift now

136

147

137instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where

148instance (Reflex t, Adjustable t m, MonadHold t m, Semigroup w) => Adjustable t (EventWriterT t w m) where

138 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

149 runWithReplace = runWithReplaceEventWriterTWith $ \dm0 dm' -> lift $ runWithReplace dm0 dm'

src/Reflex/FastWeak.hs+10

@@ -151,6 +151,16 @@ getFastWeakTicket w = do

151

152-- | Create a 'FastWeakTicket' directly from a value, creating a 'FastWeak' in the process

153-- which can be obtained with 'getFastWeakTicketValue'.

154+--

155+-- This function is marked NOINLINE so it is opaque to GHC.

156+-- If we do not do this, then GHC will sometimes fuse the constructor away

157+-- so any weak references that are attached to the ticket will have their

158+-- finalizer run. Using the opaque constructor, GHC does not see the

159+-- constructor application, so it behaves like an IORef and cannot be fused away.

160+--

161+-- The result is also evaluated to WHNF, since forcing a thunk invalidates

162+-- the weak pointer to it in some cases.

163+{-# NOINLINE mkFastWeakTicket #-}

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

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

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

166-- associated FastWeak to actually be weak

src/Reflex/Host/Headless.hsnew file+128

@@ -0,0 +1,128 @@

1+{-# LANGUAGE LambdaCase #-}

2+{-# LANGUAGE FlexibleContexts #-}

3+{-# LANGUAGE RankNTypes #-}

4+{-# LANGUAGE TypeFamilies #-}

5+{-# LANGUAGE ConstraintKinds #-}

7+module Reflex.Host.Headless where

9+import Control.Concurrent.Chan (newChan, readChan)

10+import Control.Monad (unless)

11+import Control.Monad.Fix (MonadFix, fix)

12+import Control.Monad.IO.Class (MonadIO, liftIO)

13+import Control.Monad.Primitive (PrimMonad)

14+import Control.Monad.Ref (MonadRef, Ref, readRef)

15+import Data.Dependent.Sum (DSum (..), (==>))

16+import Data.Foldable (for_)

17+import Data.Functor.Identity (Identity(..))

18+import Data.IORef (IORef, readIORef)

19+import Data.Maybe (catMaybes, fromMaybe)

20+import Data.Traversable (for)

21+

22+import Reflex

23+import Reflex.Host.Class

24+

25+type MonadHeadlessApp t m =

26+ ( Adjustable t m

27+ , MonadFix m

28+ , MonadHold t m

29+ , MonadIO (HostFrame t)

30+ , MonadIO (Performable m)

31+ , MonadIO m

32+ , MonadRef (HostFrame t)

33+ , NotReady t m

34+ , PerformEvent t m

35+ , PostBuild t m

36+ , PrimMonad (HostFrame t)

37+ , Ref (HostFrame t) ~ IORef

38+ , Ref m ~ IORef

39+ , Reflex t

40+ , ReflexHost t

41+ , TriggerEvent t m

42+ )

43+

44+-- | Run a headless FRP network. Inside the action, you will most probably use

45+-- the capabilities provided by the 'TriggerEvent' and 'PerformEvent' type

46+-- classes to interface the FRP network with the outside world. Useful for

47+-- testing. Each headless network runs on its own spider timeline.

48+runHeadlessApp

49+ :: (forall t m. MonadHeadlessApp t m => m (Event t ()))

50+ -- ^ The action to be run in the headless FRP network. The FRP network is

51+ -- closed at the first occurrence of the resulting 'Event'.

52+ -> IO ()

53+runHeadlessApp guest =

54+ -- We are using the 'Spider' implementation of reflex. Running the host

55+ -- allows us to take actions on the FRP timeline.

56+ withSpiderTimeline $ runSpiderHostForTimeline $ do

57+ -- Create the "post-build" event and associated trigger. This event fires

58+ -- once, when the application starts.

59+ (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

60+ -- Create a queue to which we will write 'Event's that need to be

61+ -- processed.

62+ events <- liftIO newChan

63+ -- Run the "guest" application, providing the appropriate context. We'll

64+ -- pure the result of the action, and a 'FireCommand' that will be used to

65+ -- trigger events.

66+ (result, fc@(FireCommand fire)) <- do

67+ hostPerformEventT $ -- Allows the guest app to run

68+ -- 'performEvent', so that actions

69+ -- (e.g., IO actions) can be run when

70+ -- 'Event's fire.

71+

72+ flip runPostBuildT postBuild $ -- Allows the guest app to access to

73+ -- a "post-build" 'Event'

74+

75+ flip runTriggerEventT events $ -- Allows the guest app to create new

76+ -- events and triggers and write

77+ -- those triggers to a channel from

78+ -- which they will be read and

79+ -- processed.

80+ guest

81+

82+ -- Read the trigger reference for the post-build event. This will be

83+ -- 'Nothing' if the guest application hasn't subscribed to this event.

84+ mPostBuildTrigger <- readRef postBuildTriggerRef

85+

86+ -- Subscribe to an 'Event' of that the guest application can use to

87+ -- request application shutdown. We'll check whether this 'Event' is firing

88+ -- to determine whether to terminate.

89+ shutdown <- subscribeEvent result

90+

91+ -- When there is a subscriber to the post-build event, fire the event.

92+ soa <- for mPostBuildTrigger $ \postBuildTrigger ->

93+ fire [postBuildTrigger :=> Identity ()] $ isFiring shutdown

94+

95+ -- The main application loop. We wait for new events and fire those that

96+ -- have subscribers. If we detect a shutdown request, the application

97+ -- terminates.

98+ unless (or (fromMaybe [] soa)) $ fix $ \loop -> do

99+ -- Read the next event (blocking).

100+ ers <- liftIO $ readChan events

101+ stop <- do

102+ -- Fire events that have subscribers.

103+ fireEventTriggerRefs fc ers $

104+ -- Check if the shutdown 'Event' is firing.

105+ isFiring shutdown

106+ if or stop

107+ then pure ()

108+ else loop

109+ where

110+ isFiring ev = readEvent ev >>= \case

111+ Nothing -> pure False

112+ Just _ -> pure True

113+ -- Use the given 'FireCommand' to fire events that have subscribers

114+ -- and call the callback for the 'TriggerInvocation' of each.

115+ fireEventTriggerRefs

116+ :: MonadIO m

117+ => FireCommand t m

118+ -> [DSum (EventTriggerRef t) TriggerInvocation]

119+ -> ReadPhase m a

120+ -> m [a]

121+ fireEventTriggerRefs (FireCommand fire) ers rcb = do

122+ mes <- liftIO $

123+ for ers $ \(EventTriggerRef er :=> TriggerInvocation a _) -> do

124+ me <- readIORef er

125+ pure $ fmap (==> a) me

126+ a <- fire (catMaybes mes) rcb

127+ liftIO $ for_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb

128+ pure a

src/Reflex/PerformEvent/Base.hs+2

@@ -164,6 +164,8 @@ instance (ReflexHost t, MonadHold t m) => MonadHold t (PerformEventT t m) where

164 buildDynamic getV0 v' = PerformEventT $ lift $ buildDynamic getV0 v'

165 {-# INLINABLE headE #-}

166 headE = PerformEventT . lift . headE

167+ {-# INLINABLE now #-}

168+ now = PerformEventT . lift $ now

167

169

168instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where

170instance (MonadRef (HostFrame t), ReflexHost t) => MonadRef (PerformEventT t m) where

169 type Ref (PerformEventT t m) = Ref (HostFrame t)

171 type Ref (PerformEventT t m) = Ref (HostFrame t)

src/Reflex/PerformEvent/Class.hs+6−1

@@ -8,7 +8,6 @@

8{-# LANGUAGE RankNTypes #-}

9{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE TypeFamilies #-}

11−{-# LANGUAGE TypeOperators #-}

12{-# LANGUAGE UndecidableInstances #-}

11{-# LANGUAGE UndecidableInstances #-}

13#ifdef USE_REFLEX_OPTIMIZER

12#ifdef USE_REFLEX_OPTIMIZER

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

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

@@ -22,6 +21,7 @@ import Reflex.Class

22import Reflex.TriggerEvent.Class

21import Reflex.TriggerEvent.Class

24import Control.Monad.Reader

23import Control.Monad.Reader

24+import Control.Monad.Trans.Maybe (MaybeT (..))

26-- | 'PerformEvent' represents actions that can trigger other actions based on

27-- 'Event's.

@@ -61,3 +61,8 @@ instance PerformEvent t m => PerformEvent t (ReaderT r m) where

61 performEvent e = do

62 r <- ask

63 lift $ performEvent $ flip runReaderT r <$> e

64+

65+instance PerformEvent t m => PerformEvent t (MaybeT m) where

66+ type Performable (MaybeT m) = MaybeT (Performable m)

67+ performEvent_ = lift . performEvent_ . fmapCheap (void . runMaybeT)

68+ performEvent = lift . fmap (fmapMaybe id) . performEvent . fmapCheap runMaybeT

src/Reflex/PostBuild/Base.hs+2−1

@@ -9,7 +9,6 @@

9{-# LANGUAGE RecursiveDo #-}

10{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeFamilies #-}

12−{-# LANGUAGE TypeOperators #-}

13{-# LANGUAGE UndecidableInstances #-}

12{-# LANGUAGE UndecidableInstances #-}

14#ifdef USE_REFLEX_OPTIMIZER

13#ifdef USE_REFLEX_OPTIMIZER

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

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

@@ -84,6 +83,8 @@ instance MonadHold t m => MonadHold t (PostBuildT t m) where

84 buildDynamic a0 = lift . buildDynamic a0

83 buildDynamic a0 = lift . buildDynamic a0

85 {-# INLINABLE headE #-}

84 {-# INLINABLE headE #-}

86 headE = lift . headE

85 headE = lift . headE

86+ {-# INLINABLE now #-}

87+ now = lift now

88instance PerformEvent t m => PerformEvent t (PostBuildT t m) where

89instance PerformEvent t m => PerformEvent t (PostBuildT t m) where

89 type Performable (PostBuildT t m) = Performable m

90 type Performable (PostBuildT t m) = Performable m

src/Reflex/PostBuild/Class.hs−1

@@ -6,7 +6,6 @@

6{-# LANGUAGE FunctionalDependencies #-}

7{-# LANGUAGE ScopedTypeVariables #-}

8{-# LANGUAGE TypeFamilies #-}

9−{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE UndecidableInstances #-}

9{-# LANGUAGE UndecidableInstances #-}

11#ifdef USE_REFLEX_OPTIMIZER

10#ifdef USE_REFLEX_OPTIMIZER

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

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

src/Reflex/Profiled.hs+59−5

@@ -26,8 +26,10 @@ import Control.Monad.Primitive

26import Control.Monad.Reader

27import Control.Monad.Ref

28import Control.Monad.State.Strict (StateT, execStateT, modify)

29+import Data.Bifunctor

29import Data.Coerce

30import Data.Coerce

30−import Data.Dependent.Map (DMap, GCompare)

31+import Data.Dependent.Map (DMap)

32+import Data.GADT.Compare (GCompare)

31import Data.FastMutableIntMap

33import Data.FastMutableIntMap

32import Data.IORef

34import Data.IORef

33import Data.List

35import Data.List

@@ -42,12 +44,20 @@ import Foreign.Ptr

42import GHC.Foreign

44import GHC.Foreign

43import GHC.IO.Encoding

45import GHC.IO.Encoding

44import GHC.Stack

46import GHC.Stack

47+import Reflex.Adjustable.Class

48+import Reflex.BehaviorWriter.Class

45import Reflex.Class

49import Reflex.Class

50+import Reflex.DynamicWriter.Class

51+import Reflex.EventWriter.Class

46import Reflex.Host.Class

52import Reflex.Host.Class

53+import Reflex.NotReady.Class

47import Reflex.PerformEvent.Class

54import Reflex.PerformEvent.Class

55+import Reflex.PostBuild.Class

56+import Reflex.Query.Class

57+import Reflex.Requester.Class

58+import Reflex.TriggerEvent.Class

49import System.IO.Unsafe

60import System.IO.Unsafe

50−import Unsafe.Coerce

52data ProfiledTimeline t

62data ProfiledTimeline t

@@ -137,7 +147,7 @@ instance Reflex t => Reflex (ProfiledTimeline t) where

137 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

147 pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e

138 pull = Behavior_Profiled . pull . coerce

148 pull = Behavior_Profiled . pull . coerce

139 fanG (Event_Profiled e) = EventSelectorG $ coerce $ selectG (fanG $ profileEvent e)

149 fanG (Event_Profiled e) = EventSelectorG $ coerce $ selectG (fanG $ profileEvent e)

140− mergeG :: forall (k :: z -> *) q v. GCompare k

150+ mergeG :: forall z (k :: z -> *) q v. GCompare k

141 => (forall a. q a -> Event (ProfiledTimeline t) (v a))

151 => (forall a. q a -> Event (ProfiledTimeline t) (v a))

142 -> DMap k q -> Event (ProfiledTimeline t) (DMap k v)

152 -> DMap k q -> Event (ProfiledTimeline t) (DMap k v)

143 mergeG nt = Event_Profiled #. mergeG (coerce nt)

153 mergeG nt = Event_Profiled #. mergeG (coerce nt)

@@ -147,8 +157,8 @@ instance Reflex t => Reflex (ProfiledTimeline t) where

147 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

157 updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d

148 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

158 unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'

149 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

159 unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'

150− mergeIncrementalG nt = (Event_Profiled . coerce) #. mergeIncrementalG nt

160+ mergeIncrementalG nt res = Event_Profiled $ mergeIncrementalG (coerce nt) (coerce res)

151− mergeIncrementalWithMoveG nt = (Event_Profiled . coerce) #. mergeIncrementalWithMoveG nt

161+ mergeIncrementalWithMoveG nt res = Event_Profiled $ mergeIncrementalWithMoveG (coerce nt) (coerce res)

152 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

162 currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i

153 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

163 updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i

154 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

164 incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i

@@ -174,10 +184,21 @@ instance MonadHold t m => MonadHold (ProfiledTimeline t) (ProfiledM m) where

174 holdIncremental v0 (Event_Profiled v') = ProfiledM $ Incremental_Profiled <$> holdIncremental v0 v'

184 holdIncremental v0 (Event_Profiled v') = ProfiledM $ Incremental_Profiled <$> holdIncremental v0 v'

175 buildDynamic (ProfiledM v0) (Event_Profiled v') = ProfiledM $ Dynamic_Profiled <$> buildDynamic v0 v'

185 buildDynamic (ProfiledM v0) (Event_Profiled v') = ProfiledM $ Dynamic_Profiled <$> buildDynamic v0 v'

176 headE (Event_Profiled e) = ProfiledM $ Event_Profiled <$> headE e

186 headE (Event_Profiled e) = ProfiledM $ Event_Profiled <$> headE e

187+ now = ProfiledM $ Event_Profiled <$> now

177

188

178instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where

189instance MonadSample t m => MonadSample (ProfiledTimeline t) (ProfiledM m) where

179 sample (Behavior_Profiled b) = ProfiledM $ sample b

190 sample (Behavior_Profiled b) = ProfiledM $ sample b

180

191

192+instance Adjustable t m => Adjustable (ProfiledTimeline t) (ProfiledM m) where

193+ runWithReplace a0 a' = (fmap . fmap) coerce . lift $

194+ runWithReplace (coerce a0) (coerce $ coerce <$> a')

195+ traverseIntMapWithKeyWithAdjust f dm0 dm' = (fmap . fmap) coerce . lift $

196+ traverseIntMapWithKeyWithAdjust (\k v -> coerce $ f k v) dm0 (coerce dm')

197+ traverseDMapWithKeyWithAdjust f dm0 dm' = (fmap . fmap) coerce . lift $

198+ traverseDMapWithKeyWithAdjust (\k v -> coerce $ f k v) dm0 (coerce dm')

199+ traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = (fmap . fmap) coerce . lift $

200+ traverseDMapWithKeyWithAdjustWithMove (\k v -> coerce $ f k v) dm0 (coerce dm')

201+

181instance MonadTrans ProfiledM where

202instance MonadTrans ProfiledM where

182 lift = ProfiledM

203 lift = ProfiledM

183

204

@@ -189,6 +210,39 @@ instance PerformEvent t m => PerformEvent (ProfiledTimeline t) (ProfiledM m) whe

189 performEvent_ = lift . performEvent_ . coerce

210 performEvent_ = lift . performEvent_ . coerce

190 performEvent = lift . fmap coerce . performEvent . coerce

211 performEvent = lift . fmap coerce . performEvent . coerce

191

212

213+instance TriggerEvent t m => TriggerEvent (ProfiledTimeline t) (ProfiledM m) where

214+ newTriggerEvent = first coerce <$> lift newTriggerEvent

215+ newTriggerEventWithOnComplete = first coerce <$> lift newTriggerEventWithOnComplete

216+ newEventWithLazyTriggerWithOnComplete f = coerce <$> lift (newEventWithLazyTriggerWithOnComplete f)

217+

218+instance PostBuild t m => PostBuild (ProfiledTimeline t) (ProfiledM m) where

219+ getPostBuild = coerce <$> lift getPostBuild

220+

221+instance NotReady t m => NotReady (ProfiledTimeline t) (ProfiledM m) where

222+ notReady = lift notReady

223+ notReadyUntil = lift . notReadyUntil . coerce

224+

225+instance BehaviorWriter t w m => BehaviorWriter (ProfiledTimeline t) w (ProfiledM m) where

226+ tellBehavior = lift . tellBehavior . coerce

227+

228+instance DynamicWriter t w m => DynamicWriter (ProfiledTimeline t) w (ProfiledM m) where

229+ tellDyn = lift . tellDyn . coerce

230+

231+instance EventWriter t w m => EventWriter (ProfiledTimeline t) w (ProfiledM m) where

232+ tellEvent = lift . tellEvent . coerce

233+

234+instance MonadQuery t q m => MonadQuery (ProfiledTimeline t) q (ProfiledM m) where

235+ tellQueryIncremental = lift . tellQueryIncremental . coerce

236+ askQueryResult = coerce <$> lift askQueryResult

237+ queryIncremental = fmap coerce . lift . queryIncremental . coerce

238+

239+instance Requester t m => Requester (ProfiledTimeline t) (ProfiledM m) where

240+ type Request (ProfiledM m) = Request m

241+ type Response (ProfiledM m) = Response m

242+

243+ requesting = fmap coerce . lift . requesting . coerce

244+ requesting_ = lift . requesting_ . coerce

245+

192instance MonadRef m => MonadRef (ProfiledM m) where

246instance MonadRef m => MonadRef (ProfiledM m) where

193 type Ref (ProfiledM m) = Ref m

247 type Ref (ProfiledM m) = Ref m

194 newRef = lift . newRef

248 newRef = lift . newRef

src/Reflex/Pure.hs+6−1

@@ -32,7 +32,8 @@ module Reflex.Pure

32 ) where

34import Control.Monad

35−import Data.Dependent.Map (DMap, GCompare)

35+import Data.Dependent.Map (DMap)

36+import Data.GADT.Compare (GCompare)

36import qualified Data.Dependent.Map as DMap

37import qualified Data.Dependent.Map as DMap

37import Data.IntMap (IntMap)

38import Data.IntMap (IntMap)

38import qualified Data.IntMap as IntMap

39import qualified Data.IntMap as IntMap

@@ -210,3 +211,7 @@ instance (Enum t, HasTrie t, Ord t) => MonadHold (Pure t) ((->) t) where

210 Just x -> fromMaybe lastValue $ apply x lastValue

211 Just x -> fromMaybe lastValue $ apply x lastValue

211

212

212 headE = slowHeadE

213 headE = slowHeadE

214+ now t = Event $ guard . (t ==)

215+

216+

217+

src/Reflex/Query/Base.hs+9−3

@@ -22,16 +22,19 @@ module Reflex.Query.Base

22import Control.Applicative (liftA2)

23import Control.Monad.Exception

24import Control.Monad.Fix

25+import Control.Monad.Morph

25import Control.Monad.Primitive

26import Control.Monad.Primitive

26import Control.Monad.Reader

27import Control.Monad.Reader

27import Control.Monad.Ref

28import Control.Monad.Ref

28import Control.Monad.State.Strict

29import Control.Monad.State.Strict

29import Data.Align

30import Data.Align

30−import Data.Dependent.Map (DMap, DSum (..))

31+import Data.Dependent.Map (DMap)

31import qualified Data.Dependent.Map as DMap

32import qualified Data.Dependent.Map as DMap

33+import Data.Dependent.Sum (DSum(..))

32import Data.Foldable

34import Data.Foldable

33import Data.Functor.Compose

35import Data.Functor.Compose

34import Data.Functor.Misc

36import Data.Functor.Misc

37+import Data.GADT.Compare (GCompare)

35import Data.IntMap (IntMap)

38import Data.IntMap (IntMap)

36import qualified Data.IntMap as IntMap

39import qualified Data.IntMap as IntMap

37import Data.Map (Map)

40import Data.Map (Map)

@@ -135,7 +138,7 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t

135 tellQueryIncremental $ unsafeBuildIncremental (fold <$> mapM sampleBs liftedBs0) qpatch

138 tellQueryIncremental $ unsafeBuildIncremental (fold <$> mapM sampleBs liftedBs0) qpatch

136 return (liftedResult0, liftedResult')

139 return (liftedResult0, liftedResult')

137

140

138− traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) v v'. (DMap.GCompare k) => (forall a. k a -> v a -> QueryT t q m (v' a)) -> DMap k v -> Event t (PatchDMap k v) -> QueryT t q m (DMap k v', Event t (PatchDMap k v'))

141+ traverseDMapWithKeyWithAdjust :: forall (k :: * -> *) v v'. (GCompare k) => (forall a. k a -> v a -> QueryT t q m (v' a)) -> DMap k v -> Event t (PatchDMap k v) -> QueryT t q m (DMap k v', Event t (PatchDMap k v'))

139 traverseDMapWithKeyWithAdjust f dm0 dm' = do

142 traverseDMapWithKeyWithAdjust f dm0 dm' = do

140 let f' :: forall a. k a -> v a -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) (Compose (QueryTLoweredResult t q) v' a)

143 let f' :: forall a. k a -> v a -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) (Compose (QueryTLoweredResult t q) v' a)

141 f' k v = fmap (Compose . QueryTLoweredResult) $ flip runStateT [] $ unQueryT $ f k v

144 f' k v = fmap (Compose . QueryTLoweredResult) $ flip runStateT [] $ unQueryT $ f k v

@@ -180,7 +183,7 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t

180 tellQueryIncremental $ unsafeBuildIncremental (fold <$> mapM sampleBs liftedBs0) qpatch

183 tellQueryIncremental $ unsafeBuildIncremental (fold <$> mapM sampleBs liftedBs0) qpatch

181 return (liftedResult0, liftedResult')

184 return (liftedResult0, liftedResult')

182

185

183− traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) v v'. (DMap.GCompare k) => (forall a. k a -> v a -> QueryT t q m (v' a)) -> DMap k v -> Event t (PatchDMapWithMove k v) -> QueryT t q m (DMap k v', Event t (PatchDMapWithMove k v'))

186+ traverseDMapWithKeyWithAdjustWithMove :: forall (k :: * -> *) v v'. (GCompare k) => (forall a. k a -> v a -> QueryT t q m (v' a)) -> DMap k v -> Event t (PatchDMapWithMove k v) -> QueryT t q m (DMap k v', Event t (PatchDMapWithMove k v'))

184 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do

187 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = do

185 let f' :: forall a. k a -> v a -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) (Compose (QueryTLoweredResult t q) v' a)

188 let f' :: forall a. k a -> v a -> EventWriterT t q (ReaderT (Dynamic t (QueryResult q)) m) (Compose (QueryTLoweredResult t q) v' a)

186 f' k v = fmap (Compose . QueryTLoweredResult) $ flip runStateT [] $ unQueryT $ f k v

189 f' k v = fmap (Compose . QueryTLoweredResult) $ flip runStateT [] $ unQueryT $ f k v

@@ -237,6 +240,9 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t

237instance MonadTrans (QueryT t q) where

240instance MonadTrans (QueryT t q) where

238 lift = QueryT . lift . lift . lift

241 lift = QueryT . lift . lift . lift

239

242

243+instance MFunctor (QueryT t q) where

244+ hoist = mapQueryT

245+

240instance PrimMonad m => PrimMonad (QueryT t q m) where

246instance PrimMonad m => PrimMonad (QueryT t q m) where

241 type PrimState (QueryT t q m) = PrimState m

247 type PrimState (QueryT t q m) = PrimState m

242 primitive = lift . primitive

248 primitive = lift . primitive

src/Reflex/Query/Class.hs+44−4

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleContexts #-}

3{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

@@ -21,6 +22,7 @@ module Reflex.Query.Class

21 , MonadQuery (..)

22 , MonadQuery (..)

22 , tellQueryDyn

23 , tellQueryDyn

23 , queryDyn

24 , queryDyn

25+ , subQuery

24 , mapQuery

26 , mapQuery

25 , mapQueryResult

27 , mapQueryResult

26 ) where

28 ) where

@@ -35,6 +37,9 @@ import Data.Map.Monoidal (MonoidalMap)

35import qualified Data.Map.Monoidal as MonoidalMap

37import qualified Data.Map.Monoidal as MonoidalMap

36import Data.Semigroup (Semigroup(..))

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

37import Foreign.Storable

39import Foreign.Storable

40+import Data.Void

41+import Data.Monoid hiding ((<>))

42+import Control.Applicative

39import Reflex.Class

44import Reflex.Class

@@ -50,6 +55,37 @@ instance (Ord k, Query v) => Query (MonoidalMap k v) where

50 type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)

55 type QueryResult (MonoidalMap k v) = MonoidalMap k (QueryResult v)

51 crop q r = MonoidalMap.intersectionWith (flip crop) r q

56 crop q r = MonoidalMap.intersectionWith (flip crop) r q

58+-- | the result of two queries is both results.

59+instance (Query a, Query b) => Query (a, b) where

60+ type QueryResult (a, b) = (QueryResult a, QueryResult b)

61+ crop (x, x') (y, y') = (crop x y, crop x' y')

62+

63+-- | Trivial queries have trivial results.

64+instance Query () where

65+ type QueryResult () = ()

66+ crop _ _ = ()

67+

68+-- | The result of an absurd query is trivial; If you can ask the question, the

69+-- answer cannot tell you anything you didn't already know.

70+--

71+-- 'QueryResult Void = @Void@' seems like it would also work, but that has

72+-- problems of robustness. In some applications, an unasked question can still

73+-- be answered, so it is important that the result is inhabited even when the

74+-- question isn't. Applications that wish to prevent this can mandate that the

75+-- query result be paired with the query: then the whole response will be

76+-- uninhabited as desired.

77+instance Query Void where

78+ type QueryResult Void = ()

79+ crop = absurd

80+

81+#if MIN_VERSION_base(4,12,0)

82+-- | We can lift queries into monoidal containers.

83+-- But beware of Applicatives whose monoid is different from (pure mempty, liftA2 mappend)

84+instance (Query q, Applicative f) => Query (Ap f q) where

85+ type QueryResult (Ap f q) = Ap f (QueryResult q)

86+ crop = liftA2 crop

87+#endif

88+

53-- | QueryMorphism's must be group homomorphisms when acting on the query type

89-- | QueryMorphism's must be group homomorphisms when acting on the query type

54-- and compatible with the query relationship when acting on the query result.

90-- and compatible with the query relationship when acting on the query result.

55data QueryMorphism q q' = QueryMorphism

91data QueryMorphism q q' = QueryMorphism

@@ -89,7 +125,7 @@ instance Group SelectedCount where

125

90instance Additive SelectedCount

126instance Additive SelectedCount

127

92−-- | The Semigroup/Monoid/Group instances for a Query containing 'SelectedCount's should use

128+-- | The Semigroup\/Monoid\/Group instances for a Query containing 'SelectedCount's should use

93-- this function which returns Nothing if the result is 0. This allows the pruning of leaves

129-- this function which returns Nothing if the result is 0. This allows the pruning of leaves

94-- of the 'Query' that are no longer wanted.

130-- of the 'Query' that are no longer wanted.

95combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount

131combineSelectedCounts :: SelectedCount -> SelectedCount -> Maybe SelectedCount

@@ -97,12 +133,12 @@ combineSelectedCounts (SelectedCount i) (SelectedCount j) = if i == negate j the

133

98-- | A class that allows sending of 'Query's and retrieval of 'QueryResult's. See 'queryDyn' for a commonly

134-- | A class that allows sending of 'Query's and retrieval of 'QueryResult's. See 'queryDyn' for a commonly

99-- used interface.

135-- used interface.

100−class (Group q, Additive q, Query q) => MonadQuery t q m | m -> q t where

136+class (Group q, Additive q, Query q, Monad m) => MonadQuery t q m | m -> q t where

101 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()

137 tellQueryIncremental :: Incremental t (AdditivePatch q) -> m ()

102 askQueryResult :: m (Dynamic t (QueryResult q))

138 askQueryResult :: m (Dynamic t (QueryResult q))

103 queryIncremental :: Incremental t (AdditivePatch q) -> m (Dynamic t (QueryResult q))

139 queryIncremental :: Incremental t (AdditivePatch q) -> m (Dynamic t (QueryResult q))

104

140

105−instance (Monad m, MonadQuery t q m) => MonadQuery t q (ReaderT r m) where

141+instance MonadQuery t q m => MonadQuery t q (ReaderT r m) where

106 tellQueryIncremental = lift . tellQueryIncremental

142 tellQueryIncremental = lift . tellQueryIncremental

107 askQueryResult = lift askQueryResult

143 askQueryResult = lift askQueryResult

108 queryIncremental = lift . queryIncremental

144 queryIncremental = lift . queryIncremental

@@ -112,7 +148,11 @@ tellQueryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m ()

112tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)

148tellQueryDyn d = tellQueryIncremental $ unsafeBuildIncremental (sample (current d)) $ attachWith (\old new -> AdditivePatch $ new ~~ old) (current d) (updated d)

113

149

114-- | Retrieve 'Dynamic'ally updating 'QueryResult's for a 'Dynamic'ally updating 'Query'.

150-- | Retrieve 'Dynamic'ally updating 'QueryResult's for a 'Dynamic'ally updating 'Query'.

115−queryDyn :: (Reflex t, Monad m, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

151+queryDyn :: (Reflex t, MonadQuery t q m) => Dynamic t q -> m (Dynamic t (QueryResult q))

116queryDyn q = do

152queryDyn q = do

117 tellQueryDyn q

153 tellQueryDyn q

118 zipDynWith crop q <$> askQueryResult

154 zipDynWith crop q <$> askQueryResult

155+

156+-- | Use a query morphism to operate on a smaller version of a query.

157+subQuery :: (Reflex t, MonadQuery t q2 m) => QueryMorphism q1 q2 -> Dynamic t q1 -> m (Dynamic t (QueryResult q1))

158+subQuery (QueryMorphism f g) x = fmap g <$> queryDyn (fmap f x)

src/Reflex/Requester/Base.hs+97−27

@@ -1,6 +1,7 @@

1-- | This module provides 'RequesterT', the standard implementation of

2-- 'Requester'.

3{-# LANGUAGE AllowAmbiguousTypes #-}

4+{-# LANGUAGE ApplicativeDo #-}

4{-# LANGUAGE CPP #-}

5{-# LANGUAGE CPP #-}

5{-# LANGUAGE EmptyDataDecls #-}

6{-# LANGUAGE EmptyDataDecls #-}

6{-# LANGUAGE ExistentialQuantification #-}

7{-# LANGUAGE ExistentialQuantification #-}

@@ -32,6 +33,7 @@ module Reflex.Requester.Base

32 , requesterDataToList

33 , requesterDataToList

33 , singletonRequesterData

34 , singletonRequesterData

34 , matchResponsesWithRequests

35 , matchResponsesWithRequests

36+ , matchResponseMapWithRequests

35 , multiEntry

37 , multiEntry

36 , unMultiEntry

38 , unMultiEntry

37 , requesting'

39 , requesting'

@@ -49,14 +51,17 @@ import Reflex.TriggerEvent.Class

49import Control.Applicative (liftA2)

51import Control.Applicative (liftA2)

50import Control.Monad.Exception

52import Control.Monad.Exception

51import Control.Monad.Identity

53import Control.Monad.Identity

54+import Control.Monad.Morph

52import Control.Monad.Primitive

55import Control.Monad.Primitive

53import Control.Monad.Reader

56import Control.Monad.Reader

54import Control.Monad.Ref

57import Control.Monad.Ref

55import Control.Monad.State.Strict

58import Control.Monad.State.Strict

56import Data.Bits

59import Data.Bits

57import Data.Coerce

60import Data.Coerce

61+import Data.Constraint

58−import Data.Dependent.Map (DMap, DSum (..))

62+import Data.Dependent.Map (DMap)

59import qualified Data.Dependent.Map as DMap

63import qualified Data.Dependent.Map as DMap

64+import Data.Dependent.Sum (DSum (..))

60import Data.Functor.Compose

65import Data.Functor.Compose

61import Data.Functor.Misc

66import Data.Functor.Misc

62import Data.IntMap.Strict (IntMap)

67import Data.IntMap.Strict (IntMap)

@@ -79,19 +84,51 @@ newtype TagMap (f :: * -> *) = TagMap (IntMap Any)

80newtype RequesterData f = RequesterData (TagMap (Entry f))

85newtype RequesterData f = RequesterData (TagMap (Entry f))

87+emptyRequesterData :: RequesterData f

88+emptyRequesterData = RequesterData $ TagMap IntMap.empty

89+

82data RequesterDataKey a where

90data RequesterDataKey a where

83 RequesterDataKey_Single :: {-# UNPACK #-} !(MyTag (Single a)) -> RequesterDataKey a

91 RequesterDataKey_Single :: {-# UNPACK #-} !(MyTag (Single a)) -> RequesterDataKey a

84 RequesterDataKey_Multi :: {-# UNPACK #-} !(MyTag Multi) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a --TODO: Don't put a second Int here (or in the other Multis); use a single Int instead

92 RequesterDataKey_Multi :: {-# UNPACK #-} !(MyTag Multi) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a --TODO: Don't put a second Int here (or in the other Multis); use a single Int instead

85− RequesterDataKey_Multi2 :: {-# UNPACK #-} !(MyTag (Multi2 k)) -> !(Some k) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a

93+ RequesterDataKey_Multi2 :: GCompare k => {-# UNPACK #-} !(MyTag (Multi2 k)) -> !(Some k) -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a

86 RequesterDataKey_Multi3 :: {-# UNPACK #-} !(MyTag Multi3) -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a

94 RequesterDataKey_Multi3 :: {-# UNPACK #-} !(MyTag Multi3) -> {-# UNPACK #-} !Int -> {-# UNPACK #-} !Int -> !(RequesterDataKey a) -> RequesterDataKey a

88singletonRequesterData :: RequesterDataKey a -> f a -> RequesterData f

96singletonRequesterData :: RequesterDataKey a -> f a -> RequesterData f

89singletonRequesterData rdk v = case rdk of

97singletonRequesterData rdk v = case rdk of

90 RequesterDataKey_Single k -> RequesterData $ singletonTagMap k $ Entry v

98 RequesterDataKey_Single k -> RequesterData $ singletonTagMap k $ Entry v

91 RequesterDataKey_Multi k k' k'' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ singletonRequesterData k'' v

99 RequesterDataKey_Multi k k' k'' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ singletonRequesterData k'' v

92− RequesterDataKey_Multi2 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ Map.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v

100+ RequesterDataKey_Multi2 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ Multi2Contents

101+ { _multi2Contents_values = Map.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v

102+ , _multi2Contents_dict = Dict

103+ }

93 RequesterDataKey_Multi3 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v

104 RequesterDataKey_Multi3 k k' k'' k''' -> RequesterData $ singletonTagMap k $ Entry $ IntMap.singleton k' $ IntMap.singleton k'' $ singletonRequesterData k''' v

105

106+mergeRequesterData :: RequesterData f -> RequesterData f -> RequesterData f

107+mergeRequesterData (RequesterData a) (RequesterData b) = RequesterData $ mergeTagMap a b

108+

109+mergeTagMap :: forall f. TagMap (Entry f) -> TagMap (Entry f) -> TagMap (Entry f)

110+mergeTagMap (TagMap m) (TagMap n) =

111+ TagMap $ IntMap.unionWithKey (g' combiner) m n

112+ where

113+ combiner :: forall a. MyTag a -> Entry f a -> Entry f a -> Entry f a

114+ combiner k (Entry a) (Entry b) = Entry $ case myKeyType k of

115+ MyTagType_Single -> a

116+ MyTagType_Multi -> IntMap.unionWith mergeRequesterData a b

117+ MyTagType_Multi2 -> case _multi2Contents_dict a of

118+ Dict -> Multi2Contents

119+ { _multi2Contents_values = Map.unionWith (IntMap.unionWith mergeRequesterData) (_multi2Contents_values a) (_multi2Contents_values b)

120+ , _multi2Contents_dict = Dict

121+ }

122+ MyTagType_Multi3 -> IntMap.unionWith (IntMap.unionWith mergeRequesterData) a b

123+ g' :: (forall a. MyTag a -> Entry f a -> Entry f a -> Entry f a) -> Int -> Any -> Any -> Any

124+ g' f rawKey a b =

125+ let k = MyTag rawKey :: MyTag a

126+ fromAny :: Any -> Entry f a

127+ fromAny = unsafeCoerce

128+ toAny :: Entry f a -> Any

129+ toAny = unsafeCoerce

130+ in toAny $ f k (fromAny a) (fromAny b)

131+

95requesterDataToList :: RequesterData f -> [DSum RequesterDataKey f]

132requesterDataToList :: RequesterData f -> [DSum RequesterDataKey f]

96requesterDataToList (RequesterData m) = do

133requesterDataToList (RequesterData m) = do

97 k :=> Entry e <- tagMapToList m

134 k :=> Entry e <- tagMapToList m

@@ -101,11 +138,12 @@ requesterDataToList (RequesterData m) = do

101 (k', e') <- IntMap.toList e

138 (k', e') <- IntMap.toList e

102 k'' :=> e'' <- requesterDataToList e'

139 k'' :=> e'' <- requesterDataToList e'

103 return $ RequesterDataKey_Multi k k' k'' :=> e''

140 return $ RequesterDataKey_Multi k k' k'' :=> e''

104− MyTagType_Multi2 -> do

141+ MyTagType_Multi2 -> case _multi2Contents_dict e of

142+ Dict -> do

105− (k', e') <- Map.toList e

143+ (k', e') <- Map.toList $ _multi2Contents_values e

106− (k'', e'') <- IntMap.toList e'

144+ (k'', e'') <- IntMap.toList e'

107− k''' :=> e''' <- requesterDataToList e''

145+ k''' :=> e''' <- requesterDataToList e''

108− return $ RequesterDataKey_Multi2 k k' k'' k''' :=> e'''

146+ return $ RequesterDataKey_Multi2 k k' k'' k''' :=> e'''

109 MyTagType_Multi3 -> do

147 MyTagType_Multi3 -> do

110 (k', e') <- IntMap.toList e

148 (k', e') <- IntMap.toList e

111 (k'', e'') <- IntMap.toList e'

149 (k'', e'') <- IntMap.toList e'

@@ -133,7 +171,13 @@ traverseRequesterData f (RequesterData m) = RequesterData <$> traverseTagMapWith

133 go k (Entry request) = Entry <$> case myKeyType k of

171 go k (Entry request) = Entry <$> case myKeyType k of

134 MyTagType_Single -> f request

172 MyTagType_Single -> f request

135 MyTagType_Multi -> traverse (traverseRequesterData f) request

173 MyTagType_Multi -> traverse (traverseRequesterData f) request

174+ MyTagType_Multi2 -> case request of

175+ Multi2Contents { _multi2Contents_values = request', _multi2Contents_dict = Dict } -> do

136− MyTagType_Multi2 -> traverse (traverse (traverseRequesterData f)) request

176+ v <- traverse (traverse (traverseRequesterData f)) request'

177+ pure $ Multi2Contents

178+ { _multi2Contents_values = v

179+ , _multi2Contents_dict = Dict

180+ }

137 MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request

181 MyTagType_Multi3 -> traverse (traverse (traverseRequesterData f)) request

138

182

139-- | 'traverseRequesterData' with its arguments flipped

183-- | 'traverseRequesterData' with its arguments flipped

@@ -177,9 +221,14 @@ instance MyTagTypeOffset Multi3 where

177type family EntryContents request a where

221type family EntryContents request a where

178 EntryContents request (Single a) = request a

222 EntryContents request (Single a) = request a

179 EntryContents request Multi = IntMap (RequesterData request)

223 EntryContents request Multi = IntMap (RequesterData request)

180− EntryContents request (Multi2 k) = Map (Some k) (IntMap (RequesterData request))

224+ EntryContents request (Multi2 k) = Multi2Contents k request

181 EntryContents request Multi3 = IntMap (IntMap (RequesterData request))

225 EntryContents request Multi3 = IntMap (IntMap (RequesterData request))

182

226

227+data Multi2Contents k request = Multi2Contents

228+ { _multi2Contents_dict :: {-# UNPACK #-} !(Dict (GCompare k)) -- This is a Dict instead of an existential context because we only want to use it in certain circumstances

229+ , _multi2Contents_values :: {-# UNPACK #-} !(Map (Some k) (IntMap (RequesterData request)))

230+ }

231+

183newtype Entry request x = Entry { unEntry :: EntryContents request x }

232newtype Entry request x = Entry { unEntry :: EntryContents request x }

184

233

185{-# INLINE singleEntry #-}

234{-# INLINE singleEntry #-}

@@ -308,7 +357,7 @@ tagRequest req = do

308 return t

357 return t

309

358

310{-# INLINE responseFromTag #-}

359{-# INLINE responseFromTag #-}

311−responseFromTag :: Monad m => MyTagWrap response (Entry response x) -> RequesterT t request response m (Event t (Entry response x))

360+responseFromTag :: forall m t request response x. Monad m => MyTagWrap response (Entry response x) -> RequesterT t request response m (Event t (Entry response x))

312responseFromTag (MyTagWrap t) = do

361responseFromTag (MyTagWrap t) = do

313 responses :: EventSelectorInt t Any <- RequesterT ask

362 responses :: EventSelectorInt t Any <- RequesterT ask

314 return $ (unsafeCoerce :: Event t Any -> Event t (Entry response x)) $ selectInt responses t

363 return $ (unsafeCoerce :: Event t Any -> Event t (Entry response x)) $ selectInt responses t

@@ -316,6 +365,9 @@ responseFromTag (MyTagWrap t) = do

316instance MonadTrans (RequesterT t request response) where

365instance MonadTrans (RequesterT t request response) where

317 lift = RequesterT . lift . lift

366 lift = RequesterT . lift . lift

318

367

368+instance MFunctor (RequesterT t request response) where

369+ hoist f = RequesterT . hoist (hoist f) . unRequesterT

370+

319instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where

371instance PerformEvent t m => PerformEvent t (RequesterT t request response m) where

320 type Performable (RequesterT t request response m) = Performable m

372 type Performable (RequesterT t request response m) = Performable m

321 performEvent_ = lift . performEvent_

373 performEvent_ = lift . performEvent_

@@ -435,9 +487,9 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN

435 let responses :: EventSelector t (Const2 (Some k) (IntMap (RequesterData response)))

487 let responses :: EventSelector t (Const2 (Some k) (IntMap (RequesterData response)))

436 responses = fanMap $ fmapCheap unpack response

488 responses = fanMap $ fmapCheap unpack response

437 unpack :: Entry response (Multi2 k) -> Map (Some k) (IntMap (RequesterData response))

489 unpack :: Entry response (Multi2 k) -> Map (Some k) (IntMap (RequesterData response))

438− unpack = unEntry

490+ unpack = _multi2Contents_values . unEntry

439 pack :: Map (Some k) (IntMap (RequesterData request)) -> Entry request (Multi2 k)

491 pack :: Map (Some k) (IntMap (RequesterData request)) -> Entry request (Multi2 k)

440− pack = Entry

492+ pack m = Entry $ Multi2Contents { _multi2Contents_values = m, _multi2Contents_dict = Dict }

441 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)

493 f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)

442 f' k (Compose (n, v)) = do

494 f' k (Compose (n, v)) = do

443 (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))

495 (result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))

@@ -458,9 +510,6 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN

458data Decoder rawResponse response =

510data Decoder rawResponse response =

459 forall a. Decoder (RequesterDataKey a) (rawResponse -> response a)

511 forall a. Decoder (RequesterDataKey a) (rawResponse -> response a)

460

512

461−-- | Matches incoming responses with previously-sent requests

462−-- and uses the provided request "decoder" function to process

463−-- incoming responses.

464matchResponsesWithRequests

513matchResponsesWithRequests

465 :: forall t rawRequest rawResponse request response m.

514 :: forall t rawRequest rawResponse request response m.

466 ( MonadFix m

515 ( MonadFix m

@@ -479,7 +528,30 @@ matchResponsesWithRequests

479 )

528 )

480 -- ^ A map of outgoing wire-format requests and an event of responses keyed

529 -- ^ A map of outgoing wire-format requests and an event of responses keyed

481 -- by the 'RequesterData' key of the associated outgoing request

530 -- by the 'RequesterData' key of the associated outgoing request

482−matchResponsesWithRequests f send recv = do

531+matchResponsesWithRequests f send recv = matchResponseMapWithRequests f send $ uncurry Map.singleton <$> recv

532+

533+-- | Matches incoming responses with previously-sent requests

534+-- and uses the provided request "decoder" function to process

535+-- incoming responses.

536+matchResponseMapWithRequests

537+ :: forall t rawRequest rawResponse request response m.

538+ ( MonadFix m

539+ , MonadHold t m

540+ , Reflex t

541+ )

542+ => (forall a. request a -> (rawRequest, rawResponse -> response a))

543+ -- ^ Given a request (from 'Requester'), produces the wire format of the

544+ -- request and a function used to process the associated response

545+ -> Event t (RequesterData request)

546+ -- ^ The outgoing requests

547+ -> Event t (Map Int rawResponse)

548+ -- ^ A map of incoming responses, tagged by an identifying key

549+ -> m ( Event t (Map Int rawRequest)

550+ , Event t (RequesterData response)

551+ )

552+ -- ^ A map of outgoing wire-format requests and an event of responses keyed

553+ -- by the 'RequesterData' key of the associated outgoing request

554+matchResponseMapWithRequests f send recv = do

483 rec nextId <- hold 1 $ fmap (\(next, _, _) -> next) outgoing

555 rec nextId <- hold 1 $ fmap (\(next, _, _) -> next) outgoing

484 waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response)) <-

556 waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response)) <-

485 holdIncremental mempty $ leftmost

557 holdIncremental mempty $ leftmost

@@ -521,17 +593,15 @@ matchResponsesWithRequests f send recv = do

521 processIncoming

593 processIncoming

522 :: Incremental t (PatchMap Int (Decoder rawResponse response))

594 :: Incremental t (PatchMap Int (Decoder rawResponse response))

523 -- A map of outstanding expected responses

595 -- A map of outstanding expected responses

524− -> Event t (Int, rawResponse)

596+ -> Event t (Map Int rawResponse)

525 -- A incoming response paired with its identifying key

597 -- A incoming response paired with its identifying key

526 -> Event t (RequesterData response, PatchMap Int v)

598 -> Event t (RequesterData response, PatchMap Int v)

527 -- The decoded response and a patch that clears the outstanding responses queue

599 -- The decoded response and a patch that clears the outstanding responses queue

528− processIncoming waitingFor inc = flip push inc $ \(n, rawRsp) -> do

600+ processIncoming waitingFor inc = flip push inc $ \rspMap -> do

529 wf <- sample $ currentIncremental waitingFor

601 wf <- sample $ currentIncremental waitingFor

530− case Map.lookup n wf of

531− Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..

532− Just (Decoder k rspF) -> do

602+ let match rawRsp (Decoder k rspF) =

533− let rsp = rspF rawRsp

603+ let rsp = rspF rawRsp

534− return $ Just

535− ( singletonRequesterData k rsp

604+ in singletonRequesterData k rsp

536− , PatchMap $ Map.singleton n Nothing

605+ matches = Map.intersectionWith match rspMap wf

537− )

606+ pure $ if Map.null matches then Nothing else Just

607+ (Map.foldl' mergeRequesterData emptyRequesterData matches, PatchMap $ Nothing <$ matches)

src/Reflex/Spider/Internal.hs+78−22

@@ -9,7 +9,6 @@

9{-# LANGUAGE GADTs #-}

10{-# LANGUAGE GeneralizedNewtypeDeriving #-}

11{-# LANGUAGE LambdaCase #-}

12−{-# LANGUAGE MultiWayIf #-}

13{-# LANGUAGE RankNTypes #-}

12{-# LANGUAGE RankNTypes #-}

14{-# LANGUAGE RoleAnnotations #-}

13{-# LANGUAGE RoleAnnotations #-}

15{-# LANGUAGE ScopedTypeVariables #-}

14{-# LANGUAGE ScopedTypeVariables #-}

@@ -20,6 +19,7 @@

20{-# LANGUAGE DeriveFunctor #-}

19{-# LANGUAGE DeriveFunctor #-}

21{-# LANGUAGE StandaloneDeriving #-}

20{-# LANGUAGE StandaloneDeriving #-}

22{-# LANGUAGE InstanceSigs #-}

21{-# LANGUAGE InstanceSigs #-}

22+{-# LANGUAGE MultiWayIf #-}

24#ifdef USE_REFLEX_OPTIMIZER

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

@@ -38,7 +38,6 @@ import Control.Monad hiding (forM, forM_, mapM, mapM_)

38import Control.Monad.Exception

39import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_)

40import Control.Monad.Primitive

41−--import Control.Monad.Reader hiding (forM, forM_, mapM, mapM_)

42import Control.Monad.Reader.Class

41import Control.Monad.Reader.Class

43import Control.Monad.IO.Class

42import Control.Monad.IO.Class

44import Control.Monad.ReaderIO

43import Control.Monad.ReaderIO

@@ -47,8 +46,9 @@ import Control.Monad.Fail (MonadFail)

47import qualified Control.Monad.Fail as MonadFail

46import qualified Control.Monad.Fail as MonadFail

48import Data.Align

47import Data.Align

49import Data.Coerce

48import Data.Coerce

50−import Data.Dependent.Map (DMap, DSum (..))

49+import Data.Dependent.Map (DMap)

51import qualified Data.Dependent.Map as DMap

50import qualified Data.Dependent.Map as DMap

51+import Data.Dependent.Sum (DSum (..))

52import Data.FastMutableIntMap (FastMutableIntMap, PatchIntMap (..))

53import qualified Data.FastMutableIntMap as FastMutableIntMap

54import Data.Foldable hiding (concat, elem, sequence_)

@@ -129,9 +129,33 @@ withStackOneLine expr = unsafePerformIO $ do

129

130#endif

131

132+debugPropagate :: Bool

133+

134+debugInvalidateHeight :: Bool

135+

136+debugInvalidate :: Bool

137+

132#ifdef DEBUG

138#ifdef DEBUG

133#define DEBUG_NODEIDS

139#define DEBUG_NODEIDS

134

140

141+#ifdef DEBUG_TRACE_PROPAGATION

142+debugPropagate = True

143+#else

144+debugPropagate = False

145+#endif

146+

147+#ifdef DEBUG_TRACE_HEIGHT

148+debugInvalidateHeight = True

149+#else

150+debugInvalidateHeight = False

151+#endif

152+

153+#ifdef DEBUG_TRACE_INVALIDATION

154+debugInvalidate = True

155+#else

156+debugInvalidate = False

157+#endif

158+

135class HasNodeId a where

159class HasNodeId a where

136 getNodeId :: a -> Int

160 getNodeId :: a -> Int

137

161

@@ -169,6 +193,10 @@ showNodeId' = ("#"<>) . show

169

193

170#else

194#else

171

195

196+debugPropagate = False

197+debugInvalidateHeight = False

198+debugInvalidate = False

199+

172-- This must be inline, or error messages will cause memory leaks due to retaining the node in question

200-- This must be inline, or error messages will cause memory leaks due to retaining the node in question

173{-# INLINE showNodeId #-}

201{-# INLINE showNodeId #-}

174showNodeId :: a -> String

202showNodeId :: a -> String

@@ -279,7 +307,20 @@ data CacheSubscribed x a

279#endif

307#endif

280 }

308 }

281

309

282−

310+nowSpiderEventM :: (HasSpiderTimeline x) => EventM x (R.Event (SpiderTimeline x) ())

311+nowSpiderEventM =

312+ SpiderEvent <$> now

313+

314+now :: (MonadIO m, Defer (Some Clear) m, HasSpiderTimeline x

315+ ) => m (Event x ())

316+now = do

317+ nowOrNot <- liftIO $ newIORef $ Just ()

318+ scheduleClear nowOrNot

319+ return . Event $ \_ -> do

320+ occ <- liftIO . readIORef $ nowOrNot

321+ return ( EventSubscription (return ()) eventSubscribedNow

322+ , occ

323+ )

283

324

284-- | Construct an 'Event' whose value is guaranteed not to be recomputed

325-- | Construct an 'Event' whose value is guaranteed not to be recomputed

285-- repeatedly

326-- repeatedly

@@ -423,16 +464,6 @@ data Subscriber x a = Subscriber

423 , subscriberRecalculateHeight :: !(Height -> IO ())

464 , subscriberRecalculateHeight :: !(Height -> IO ())

424 }

465 }

425

466

426−--TODO: Move this comment to WeakBag

427−-- These function are constructor functions that are marked NOINLINE so they are

428−-- opaque to GHC. If we do not do this, then GHC will sometimes fuse the constructor away

429−-- so any weak references that are attached to the constructors will have their

430−-- finalizer run. Using the opaque constructor, does not see the

431−-- constructor application, so it behaves like an IORef and cannot be fused away.

432−--

433−-- The result is also evaluated to WHNF, since forcing a thunk invalidates

434−-- the weak pointer to it in some cases.

435−

436newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)

467newSubscriberHold :: (HasSpiderTimeline x, Patch p) => Hold x p -> IO (Subscriber x p)

437newSubscriberHold h = return $ Subscriber

468newSubscriberHold h = return $ Subscriber

438 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h

469 { subscriberPropagate = {-# SCC "traverseHold" #-} propagateSubscriberHold h

@@ -576,6 +607,16 @@ eventSubscribedNever = EventSubscribed

576 , eventSubscribedWhoCreated = return ["never"]

607 , eventSubscribedWhoCreated = return ["never"]

577#endif

608#endif

578 }

609 }

610+eventSubscribedNow :: EventSubscribed x

611+eventSubscribedNow = EventSubscribed

612+ { eventSubscribedHeightRef = zeroRef

613+ , eventSubscribedRetained = toAny ()

614+#ifdef DEBUG_CYCLES

615+ , eventSubscribedGetParents = return []

616+ , eventSubscribedHasOwnHeightRef = False

617+ , eventSubscribedWhoCreated = return ["now"]

618+#endif

619+ }

579

620

580eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x

621eventSubscribedFan :: FanSubscribed x k v -> EventSubscribed x

581eventSubscribedFan !subscribed = EventSubscribed

622eventSubscribedFan !subscribed = EventSubscribed

@@ -1351,11 +1392,11 @@ tracePropagate p = when debugPropagate . trace p

1351

1392

1352{-# INLINE traceInvalidate #-}

1393{-# INLINE traceInvalidate #-}

1353traceInvalidate :: String -> IO ()

1394traceInvalidate :: String -> IO ()

1354−traceInvalidate = liftIO . debugStrLn

1395+traceInvalidate = when debugInvalidate . liftIO . debugStrLn

1355

1396

1356{-# INLINE traceInvalidateHeight #-}

1397{-# INLINE traceInvalidateHeight #-}

1357traceInvalidateHeight :: String -> IO ()

1398traceInvalidateHeight :: String -> IO ()

1358−traceInvalidateHeight = liftIO . debugStrLn

1399+traceInvalidateHeight = when debugInvalidateHeight . liftIO . debugStrLn

1359

1400

1360{-# INLINE trace #-}

1401{-# INLINE trace #-}

1361trace :: (CanTrace x m) => proxy x -> String -> m ()

1402trace :: (CanTrace x m) => proxy x -> String -> m ()

@@ -1426,8 +1467,11 @@ showStacks :: [[String]] -> String

1426showStacks = drawForest . listsToForest . fmap (filterStack "Reflex.Spider.Internal")

1467showStacks = drawForest . listsToForest . fmap (filterStack "Reflex.Spider.Internal")

1427

1468

1428filterStack :: String -> [String] -> [String]

1469filterStack :: String -> [String] -> [String]

1470+#ifdef DEBUG_HIDE_INTERNALS

1429filterStack prefix = filter (not . (prefix `isPrefixOf`))

1471filterStack prefix = filter (not . (prefix `isPrefixOf`))

1430−

1472+#else

1473+filterStack prefix = id

1474+#endif

1431

1475

1432#ifdef DEBUG_CYCLES

1476#ifdef DEBUG_CYCLES

1433

1477

@@ -1454,7 +1498,7 @@ instance Show EventLoopException where

1454{-# INLINE propagateSubscriberHold #-}

1498{-# INLINE propagateSubscriberHold #-}

1455propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, Patch p) => Hold x p -> p -> EventM x ()

1499propagateSubscriberHold :: forall x p. (HasSpiderTimeline x, Patch p) => Hold x p -> p -> EventM x ()

1456propagateSubscriberHold h a = do

1500propagateSubscriberHold h a = do

1457− traceM (Proxy :: Proxy x) $ liftIO $ do

1501+ {-# SCC "trace" #-} when debugPropagate $ traceM (Proxy :: Proxy x) $ liftIO $ do

1458 invalidators <- liftIO $ readIORef $ holdInvalidators h

1502 invalidators <- liftIO $ readIORef $ holdInvalidators h

1459 return $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)

1503 return $ "SubscriberHold" <> showNodeId h <> ": " ++ show (length invalidators)

1460

1504

@@ -1462,7 +1506,7 @@ propagateSubscriberHold h a = do

1462 case {-# SCC "apply" #-} apply a v of

1506 case {-# SCC "apply" #-} apply a v of

1463 Nothing -> return ()

1507 Nothing -> return ()

1464 Just v' -> do

1508 Just v' -> do

1465− withIncreasedDepth (Proxy :: Proxy x) $

1509+ {-# SCC "trace2" #-} withIncreasedDepth (Proxy :: Proxy x) $

1466 tracePropagate (Proxy :: Proxy x) ("propagateSubscriberHold: assigning Hold" <> showNodeId h)

1510 tracePropagate (Proxy :: Proxy x) ("propagateSubscriberHold: assigning Hold" <> showNodeId h)

1467 vRef <- {-# SCC "vRef" #-} liftIO $ evaluate $ holdValue h

1511 vRef <- {-# SCC "vRef" #-} liftIO $ evaluate $ holdValue h

1468 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h

1512 iRef <- {-# SCC "iRef" #-} liftIO $ evaluate $ holdInvalidators h

@@ -1994,7 +2038,7 @@ revalidateMergeHeight m = do

1994 LT -> return ()

2038 LT -> return ()

1995 EQ -> do

2039 EQ -> do

1996 let height = succHeight $ heightBagMax heights

2040 let height = succHeight $ heightBagMax heights

1997− traceInvalidate $ "recalculateSubscriberHeight: height: " <> show height

2041+ traceInvalidateHeight $ "recalculateSubscriberHeight: height: " <> show height

1998 writeIORef (_merge_heightRef m) $! height

2042 writeIORef (_merge_heightRef m) $! height

1999 subscriberRecalculateHeight (_merge_sub m) height

2043 subscriberRecalculateHeight (_merge_sub m) height

2000 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"

2044 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show (DMap.size parents) <> ") for Merge"

@@ -2158,7 +2202,7 @@ mergeIntCheap d = Event $ \sub -> do

2158 LT -> return ()

2202 LT -> return ()

2159 EQ -> do

2203 EQ -> do

2160 let height = succHeight $ heightBagMax heights

2204 let height = succHeight $ heightBagMax heights

2161− traceInvalidate $ "recalculateSubscriberHeight: height: " <> show height

2205+ traceInvalidateHeight $ "recalculateSubscriberHeight: height: " <> show height

2162 writeIORef heightRef $! height

2206 writeIORef heightRef $! height

2163 subscriberRecalculateHeight sub height

2207 subscriberRecalculateHeight sub height

2164 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show numParents <> ") for Merge"

2208 GT -> error $ "revalidateMergeHeight: more heights (" <> show (heightBagSize heights) <> ") than parents (" <> show numParents <> ") for Merge"

@@ -2476,6 +2520,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Event

2476 {-# INLINABLE headE #-}

2520 {-# INLINABLE headE #-}

2477 headE = R.slowHeadE

2521 headE = R.slowHeadE

2478-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e

2522-- headE (SpiderEvent e) = SpiderEvent <$> Reflex.Spider.Internal.headE e

2523+ {-# INLINABLE now #-}

2524+ now = nowSpiderEventM

2479

2525

2480instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where

2526instance Reflex.Class.MonadSample (SpiderTimeline x) (SpiderPullM x) where

2481 {-# INLINABLE sample #-}

2527 {-# INLINABLE sample #-}

@@ -2497,6 +2543,9 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

2497 {-# INLINABLE headE #-}

2543 {-# INLINABLE headE #-}

2498 headE = R.slowHeadE

2544 headE = R.slowHeadE

2499-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2545-- headE (SpiderEvent e) = SpiderPushM $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2546+ {-# INLINABLE now #-}

2547+ now = SpiderPushM nowSpiderEventM

2548+

2500

2549

2501instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where

2550instance HasSpiderTimeline x => Monad (Reflex.Class.Dynamic (SpiderTimeline x)) where

2502 {-# INLINE return #-}

2551 {-# INLINE return #-}

@@ -2560,6 +2609,9 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

2560 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e

2609 buildDynamic getV0 e = runFrame . runSpiderHostFrame $ Reflex.Class.buildDynamic getV0 e

2561 {-# INLINABLE headE #-}

2610 {-# INLINABLE headE #-}

2562 headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e

2611 headE e = runFrame . runSpiderHostFrame $ Reflex.Class.headE e

2612+ {-# INLINABLE now #-}

2613+ now = runFrame . runSpiderHostFrame $ Reflex.Class.now

2614+

2563

2615

2564instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

2616instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHostFrame x) where

2565 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

2617 sample = SpiderHostFrame . readBehaviorUntracked . unSpiderBehavior --TODO: This can cause problems with laziness, so we should get rid of it if we can

@@ -2576,6 +2628,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Spide

2576 {-# INLINABLE headE #-}

2628 {-# INLINABLE headE #-}

2577 headE = R.slowHeadE

2629 headE = R.slowHeadE

2578-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2630-- headE (SpiderEvent e) = SpiderHostFrame $ SpiderEvent <$> Reflex.Spider.Internal.headE e

2631+ {-# INLINABLE now #-}

2632+ now = SpiderHostFrame Reflex.Class.now

2579

2633

2580instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

2634instance HasSpiderTimeline x => Reflex.Class.MonadSample (SpiderTimeline x) (SpiderHost x) where

2581 {-# INLINABLE sample #-}

2635 {-# INLINABLE sample #-}

@@ -2596,6 +2650,8 @@ instance HasSpiderTimeline x => Reflex.Class.MonadHold (SpiderTimeline x) (Refle

2596 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e

2650 buildDynamic getV0 e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.buildDynamic getV0 e

2597 {-# INLINABLE headE #-}

2651 {-# INLINABLE headE #-}

2598 headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e

2652 headE e = Reflex.Spider.Internal.ReadPhase $ Reflex.Class.headE e

2653+ {-# INLINABLE now #-}

2654+ now = Reflex.Spider.Internal.ReadPhase Reflex.Class.now

2599

2655

2600--------------------------------------------------------------------------------

2656--------------------------------------------------------------------------------

2601-- Deprecated items

2657-- Deprecated items

@@ -2719,7 +2775,7 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2719 fanG e = R.EventSelectorG $ SpiderEvent . selectG (fanG (unSpiderEvent e))

2775 fanG e = R.EventSelectorG $ SpiderEvent . selectG (fanG (unSpiderEvent e))

2720 {-# INLINABLE mergeG #-}

2776 {-# INLINABLE mergeG #-}

2721 mergeG

2777 mergeG

2722− :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k

2778+ :: forall k2 (k :: k2 -> *) q (v :: k2 -> *). GCompare k

2723 => (forall a. q a -> R.Event (SpiderTimeline x) (v a))

2779 => (forall a. q a -> R.Event (SpiderTimeline x) (v a))

2724 -> DMap k q

2780 -> DMap k q

2725 -> R.Event (SpiderTimeline x) (DMap k v)

2781 -> R.Event (SpiderTimeline x) (DMap k v)

src/Reflex/TriggerEvent/Base.hs+2

@@ -122,6 +122,8 @@ instance MonadHold t m => MonadHold t (TriggerEventT t m) where

122 buildDynamic a0 = lift . buildDynamic a0

123 {-# INLINABLE headE #-}

124 headE = lift . headE

125+ {-# INLINABLE now #-}

126+ now = lift now

125

127

126instance Adjustable t m => Adjustable t (TriggerEventT t m) where

128instance Adjustable t m => Adjustable t (TriggerEventT t m) where

127 {-# INLINABLE runWithReplace #-}

129 {-# INLINABLE runWithReplace #-}

src/Reflex/TriggerEvent/Class.hs+6

@@ -12,6 +12,7 @@ import Reflex.Class

12import Control.Monad.Reader

13import Control.Monad.State

14import qualified Control.Monad.State.Strict as Strict

15+import Control.Monad.Trans.Maybe (MaybeT)

16--TODO: Shouldn't have IO hard-coded

17--TODO: Shouldn't have IO hard-coded

17-- | 'TriggerEvent' represents actions that can create 'Event's that can be

18-- | 'TriggerEvent' represents actions that can create 'Event's that can be

@@ -47,3 +48,8 @@ instance TriggerEvent t m => TriggerEvent t (Strict.StateT s m) where

47 newTriggerEvent = lift newTriggerEvent

48 newTriggerEvent = lift newTriggerEvent

48 newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

49 newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

49 newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

50 newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

51+

52+instance TriggerEvent t m => TriggerEvent t (MaybeT m) where

53+ newTriggerEvent = lift newTriggerEvent

54+ newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

55+ newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

test/Adjustable.hsnew file+62

@@ -0,0 +1,62 @@

1+{-# LANGUAGE BangPatterns #-}

2+{-# LANGUAGE LambdaCase #-}

3+{-# LANGUAGE RankNTypes #-}

4+{-# LANGUAGE RecursiveDo #-}

6+module Main where

8+import Control.Monad.Fix

9+import Data.Maybe

10+import qualified Data.Map as Map

11+

12+import Reflex

13+import Reflex.EventWriter.Base

14+import Reflex.Network

15+import Reflex.Patch.MapWithMove

16+import Test.Run

17+

18+main :: IO ()

19+main = do

20+ let actions = [ Increment, Update0th, Increment, Swap, Increment, Increment ]

21+ os <- runAppB testPatchMapWithMove $ map Just actions

22+ -- If the final counter value in the adjusted widgets corresponds to the number of times it has

23+ -- been incremented, we know that the networks haven't broken.

24+ let expectedCount = length $ ffilter (== Increment) actions

25+ -- let !True = last (last os) == [expectedCount,expectedCount] -- TODO re-enable this test after issue #369 has been resolved

26+ return ()

27+

28+data PatchMapTestAction

29+ = Increment

30+ | Swap

31+ | Update0th

32+ deriving Eq

33+

34+-- See https://github.com/reflex-frp/reflex/issues/369 for the bug that this is testing.

35+testPatchMapWithMove

36+ :: forall t m

37+ . ( Reflex t

38+ , Adjustable t m

39+ , MonadHold t m

40+ , MonadFix m

41+ )

42+ => Event t PatchMapTestAction

43+ -> m (Behavior t [Int])

44+testPatchMapWithMove pulse = do

45+ let pulseAction = ffor pulse $ \case

46+ Increment -> Nothing

47+ Swap -> patchMapWithMove $ Map.fromList

48+ [ (0, NodeInfo (From_Move 1) (Just 1))

49+ , (1, NodeInfo (From_Move 0) (Just 0))

50+ ]

51+ Update0th -> patchMapWithMove $ Map.fromList

52+ [ (0, NodeInfo (From_Insert 'z') Nothing) ]

53+ (_, result) <- runBehaviorWriterT $ mdo

54+ counter <- foldDyn (+) 1 $ fmapMaybe (\e -> if isNothing e then Just 1 else Nothing) pulseAction

55+ _ <- mapMapWithAdjustWithMove

56+ (\_ _ -> networkHold

57+ (tellBehavior $ constant [])

58+ ((\t -> tellBehavior $ constant [t]) <$> updated counter))

59+ (Map.fromList $ zip [0..] "ab")

60+ (fmapMaybe id pulseAction)

61+ return ()

62+ return result

test/GC.hs+1

@@ -18,6 +18,7 @@ import Data.GADT.Compare

18import Data.IORef

19import Data.Semigroup

20import Data.These

21+import Data.Type.Equality ((:~:)(Refl))

22import Data.Functor.Misc

23import Data.Functor.Misc

23import Data.Patch

24import Data.Patch

test/Headless.hsnew file+10

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

1+module Main where

3+import Reflex

4+import Reflex.Host.Headless (runHeadlessApp)

6+main :: IO ()

7+main = do

8+ runHeadlessApp $ do

9+ pb <- getPostBuild

10+ performEvent (pure <$> pb)

test/Reflex/Plan/Pure.hs+1

@@ -41,6 +41,7 @@ instance MonadHold (Pure Int) PurePlan where

41 holdIncremental initial = liftPlan . holdIncremental initial

42 buildDynamic getInitial = liftPlan . buildDynamic getInitial

43 headE = liftPlan . headE

44+ now = liftPlan now

45instance MonadSample (Pure Int) PurePlan where

46instance MonadSample (Pure Int) PurePlan where

46 sample = liftPlan . sample

47 sample = liftPlan . sample

test/Reflex/Test/CrossImpl.hs+13−8

@@ -21,11 +21,12 @@ import Reflex.Dynamic

21import Reflex.Host.Class

22import qualified Reflex.Pure as P

23import qualified Reflex.Spider.Internal as S

24+import qualified Reflex.Profiled as Prof

25import Control.Arrow (second, (&&&))

26import Control.Arrow (second, (&&&))

26import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)

27import Control.Monad.Identity hiding (forM, forM_, mapM, mapM_, sequence, sequence_)

27import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)

28import Control.Monad.State.Strict hiding (forM, forM_, mapM, mapM_, sequence, sequence_)

28−import Data.Dependent.Map (DSum (..))

29+import Data.Dependent.Sum (DSum (..))

29import Data.Foldable

30import Data.Foldable

30import Data.Map.Strict (Map)

31import Data.Map.Strict (Map)

31import qualified Data.Map.Strict as Map

32import qualified Data.Map.Strict as Map

@@ -35,8 +36,6 @@ import Data.Traversable

35import System.Exit

36import System.Exit

36import System.Mem

37import System.Mem

38−import System.IO.Unsafe

39−

40mapToPureBehavior :: Map Int a -> Behavior PureReflexDomain a

39mapToPureBehavior :: Map Int a -> Behavior PureReflexDomain a

41mapToPureBehavior m = P.Behavior $ \t -> case Map.lookupLE t m of

40mapToPureBehavior m = P.Behavior $ \t -> case Map.lookupLE t m of

42 Nothing -> error $ "mapToPureBehavior: no value for time " <> show t

41 Nothing -> error $ "mapToPureBehavior: no value for time " <> show t

@@ -73,11 +72,14 @@ instance MapMSignals (Event t a) (Event t' a) t t' where

73instance (MapMSignals a a' t t', MapMSignals b b' t t') => MapMSignals (a, b) (a', b') t t' where

72instance (MapMSignals a a' t t', MapMSignals b b' t t') => MapMSignals (a, b) (a', b') t t' where

74 mapMSignals fb fe (a, b) = liftM2 (,) (mapMSignals fb fe a) (mapMSignals fb fe b)

73 mapMSignals fb fe (a, b) = liftM2 (,) (mapMSignals fb fe a) (mapMSignals fb fe b)

75+testTimeline

76−testSpider :: (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d)) -> (Map Int a, Map Int b) -> (Map Int c, Map Int d)

76+ :: (forall m t. TestCaseConstraint t m => (Behavior t a, Event t b) -> m (Behavior t c, Event t d))

77+ -> (Map Int a, Map Int b)

78+ -> (forall m t. (MonadReflexHost t m, MonadIO m, MonadRef m, Ref m ~ Ref IO, MonadSample t m) => m (Map Int c, Map Int d))

77−testSpider builder (bMap, eMap) = unsafePerformIO $ S.runSpiderHost $ do

79+testTimeline builder (bMap, eMap) = do

78 (re, reTrigger) <- newEventWithTriggerRef

80 (re, reTrigger) <- newEventWithTriggerRef

79 (rb, rbTrigger) <- newEventWithTriggerRef

81 (rb, rbTrigger) <- newEventWithTriggerRef

80− b <- runHostFrame $ hold (error "testSpider: No value for input behavior yet") rb

82+ b <- runHostFrame $ hold (error "testTimeline: No value for input behavior yet") rb

81 (b', e') <- runHostFrame $ builder (b, re)

83 (b', e') <- runHostFrame $ builder (b, re)

82 e'Handle <- subscribeEvent e' --TODO: This should be unnecessary

84 e'Handle <- subscribeEvent e' --TODO: This should be unnecessary

83 let times = relevantTestingTimes (bMap, eMap)

85 let times = relevantTestingTimes (bMap, eMap)

@@ -102,9 +104,11 @@ testAgreement :: (Eq c, Eq d, Show c, Show d) => (forall m t. TestCaseConstraint

102testAgreement builder inputs = do

104testAgreement builder inputs = do

103 let identityResult = testPure builder inputs

105 let identityResult = testPure builder inputs

104 tracePerf "---------" $ return ()

106 tracePerf "---------" $ return ()

105− let spiderResult = testSpider builder inputs

107+ spiderResult <- S.runSpiderHost $ testTimeline builder inputs

108+ tracePerf "---------" $ return ()

109+ profiledResult <- S.runSpiderHost $ Prof.runProfiledM $ testTimeline builder inputs

106 tracePerf "---------" $ return ()

110 tracePerf "---------" $ return ()

107− let resultsAgree = identityResult == spiderResult

111+ let resultsAgree = identityResult == spiderResult && identityResult == profiledResult

108 if resultsAgree

112 if resultsAgree

109 then do --putStrLn "Success:"

113 then do --putStrLn "Success:"

110 --print identityResult

114 --print identityResult

@@ -112,6 +116,7 @@ testAgreement builder inputs = do

112 else do putStrLn "Failure:"

116 else do putStrLn "Failure:"

113 putStrLn $ "Pure result: " <> show identityResult

117 putStrLn $ "Pure result: " <> show identityResult

114 putStrLn $ "Spider result: " <> show spiderResult

118 putStrLn $ "Spider result: " <> show spiderResult

119+ putStrLn $ "Profiled result: " <> show profiledResult

115 return resultsAgree

120 return resultsAgree

116

121

117type TestCaseConstraint t m = (Reflex t, MonadSample t m, MonadHold t m, MonadFix m, MonadFix (PushM t))

122type TestCaseConstraint t m = (Reflex t, MonadSample t m, MonadHold t m, MonadFix m, MonadFix (PushM t))

test/Reflex/Test/Micro.hs+8−2

@@ -322,8 +322,14 @@ testCases =

322 let e = never <$ switch b

323 return $ void e

324 lazyHold

325−

325+ , testE "now-1" $ do

326−

326+ e1 <- events1

327+ switchHoldPromptly never . pushAlways (\a -> fmap (a <$) now) $ e1

328+ , testE "now-2" $ do

329+ e1 <- events1

330+ let e = pushAlways (\a -> if a == "a" then now else return never) e1

331+ x <- accumDyn (<>) never e

332+ return . coincidence $ updated x

327 ] where

333 ] where

328

334

329 events1, events2, events3 :: TestPlan t m => m (Event t String)

335 events1, events2, events3 :: TestPlan t m => m (Event t String)

test/RequesterT.hs+63−2

@@ -1,20 +1,36 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE BangPatterns #-}

3{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE GADTs #-}

5{-# LANGUAGE GADTs #-}

5−{-# LANGUAGE RankNTypes #-}

6+{-# LANGUAGE LambdaCase #-}

7+{-# LANGUAGE MultiParamTypeClasses #-}

6{-# LANGUAGE RecursiveDo #-}

8{-# LANGUAGE RecursiveDo #-}

7{-# LANGUAGE ScopedTypeVariables #-}

9{-# LANGUAGE ScopedTypeVariables #-}

10+{-# LANGUAGE TemplateHaskell #-}

11+{-# LANGUAGE TypeApplications #-}

12+{-# LANGUAGE TypeFamilies #-}

8module Main where

13module Main where

10−import Control.Lens

15+import Control.Lens hiding (has)

11import Control.Monad

16import Control.Monad

12import Control.Monad.Fix

17import Control.Monad.Fix

18+import Control.Monad.IO.Class (MonadIO)

19+import Data.Constraint.Extras

20+import Data.Constraint.Extras.TH

21+import Data.Constraint.Forall

13import qualified Data.Dependent.Map as DMap

22import qualified Data.Dependent.Map as DMap

14import Data.Dependent.Sum

23import Data.Dependent.Sum

15import Data.Functor.Misc

24import Data.Functor.Misc

25+import Data.List (words)

26+import Data.Map (Map)

16import qualified Data.Map as M

27import qualified Data.Map as M

28+#if !MIN_VERSION_these(4,11,0)

29+import Data.Semigroup ((<>))

30+#endif

31+import Data.Text (Text)

17import Data.These

32import Data.These

33+import Text.Read (readMaybe)

19#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))

35#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))

20import Data.These.Lens

36import Data.These.Lens

@@ -49,12 +65,19 @@ main = do

49 print os5

65 print os5

50 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]

66 os6 <- runApp' (unwrapApp delayedPulse) [Just ()]

51 print os6

67 print os6

68+ os7 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Increment 1 ]

69+ print os7

70+ os8 <- runApp' testMatchRequestsWithResponses [ Just $ TestRequest_Reverse "yoyo" ]

71+ print os8

52 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'

72 let ![[Just [1,2,3,4,5,6,7,8,9,10]]] = os1 -- The order is reversed here: see the documentation for 'runRequesterT'

53 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2

73 let ![[Just [9,7,5,3,1]],[Nothing,Nothing],[Just [10,8,6,4,2]],[Just [10,8,6,4,2],Nothing]] = os2

54 let ![[Nothing, Just [2]]] = os3

74 let ![[Nothing, Just [2]]] = os3

55 let ![[Nothing, Just [2]]] = os4

75 let ![[Nothing, Just [2]]] = os4

56 let ![[Nothing, Just [1, 2]]] = os5

76 let ![[Nothing, Just [1, 2]]] = os5

57 -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved

77 -- let ![[Nothing, Nothing]] = os6 -- TODO re-enable this test after issue #233 has been resolved

78+ let !(Just [(1,"2")]) = M.toList <$> head (head os7)

79+ let !(Just [(1,"oyoy")]) = M.toList <$> head (head os8)

80+

58 return ()

81 return ()

60unwrapRequest :: DSum tag RequestInt -> Int

83unwrapRequest :: DSum tag RequestInt -> Int

@@ -172,3 +195,41 @@ delayedPulse pulse = void $ flip runWithReplace (pure () <$ pulse) $ do

172 -- This has the effect of delaying pulse' from pulse

195 -- This has the effect of delaying pulse' from pulse

173 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse

196 (_, pulse') <- runWithReplace (pure ()) $ pure (RequestInt 1) <$ pulse

174 requestingIdentity pulse'

197 requestingIdentity pulse'

198+

199+data TestRequest a where

200+ TestRequest_Reverse :: String -> TestRequest String

201+ TestRequest_Increment :: Int -> TestRequest Int

202+

203+testMatchRequestsWithResponses

204+ :: forall m t req a

205+ . ( MonadFix m

206+ , MonadHold t m

207+ , Reflex t

208+ , PerformEvent t m

209+ , MonadIO (Performable m)

210+ , ForallF Show req

211+ , Has Read req

212+ )

213+ => Event t (req a) -> m (Event t (Map Int String))

214+testMatchRequestsWithResponses pulse = mdo

215+ (_, requests) <- runRequesterT (requesting pulse) responses

216+ let rawResponses = M.map (\v ->

217+ case words v of

218+ ["reverse", str] -> reverse str

219+ ["increment", i] -> show $ succ $ (read i :: Int)

220+ ) <$> rawRequestMap

221+ (rawRequestMap, responses) <- matchResponsesWithRequests reqEncoder requests (head . M.toList <$> rawResponses)

222+ pure rawResponses

223+ where

224+ reqEncoder :: forall a. req a -> (String, String -> Maybe a)

225+ reqEncoder r =

226+ ( whichever @Show @req @a $ show r

227+ , \x -> has @Read r $ readMaybe x

228+ )

229+

230+deriveArgDict ''TestRequest

231+

232+instance Show (TestRequest a) where

233+ show = \case

234+ TestRequest_Reverse str -> "reverse " <> str

235+ TestRequest_Increment i -> "increment " <> show i

test/hlint.hs+2−1

@@ -1,7 +1,7 @@

1module Main where

3import Control.Monad

4−import Language.Haskell.HLint3 (hlint)

4+import Language.Haskell.HLint (hlint)

5import System.Directory

6import System.Exit (exitFailure, exitSuccess)

7import System.FilePath

@@ -22,6 +22,7 @@ main = do

22 , "--ignore=Use unless"

23 , "--ignore=Reduce duplication"

24 , "--cpp-define=USE_TEMPLATE_HASKELL"

25+ , "--cpp-define=DEBUG"

25 , "--ignore=Use tuple-section"

26 , "--ignore=Use tuple-section"

26 ]

27 ]

27 recurseInto = and <$> sequence

28 recurseInto = and <$> sequence