38468bc..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+31−1

@@ -1,7 +1,37 @@

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+

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

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

6## 0.7.1.0

36## 0.7.1.0

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+4−4

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

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

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

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) [![Travis CI](https://api.travis-ci.org/reflex-frp/reflex.svg?branch=master)](https://travis-ci.org/reflex-frp/reflex) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/reflex-frp/reflex/blob/master/LICENSE)

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)

5Interactive 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.

@@ -8,7 +8,7 @@ Reflex is a fully-deterministic, higher-order Functional Reactive Programming in

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

11−### Resources

11+## Resources

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

14* [Quick Reference](Quickref.md)

@@ -18,6 +18,6 @@ Reflex is a fully-deterministic, higher-order Functional Reactive Programming in

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

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

21−### Hacking

21+## Hacking

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

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+21−8

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

1Name: reflex

2−Version: 0.7.1.0

2+Version: 0.8.2.0

3Synopsis: Higher-order Functional Reactive Programming

4Description:

5 Interactive programs without callbacks or side-effects.

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

28 ChangeLog.md

30tested-with:

31− 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,

32− GHCJS ==8.4

32+ GHCJS ==8.6

34flag use-reflex-optimizer

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

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

71 hs-source-dirs: src

72 build-depends:

73 MemoTrie == 0.6.*,

74− base >= 4.9 && < 4.14,

74+ base >= 4.11 && < 4.15,

75 bifunctors >= 5.2 && < 5.6,

76 comonad >= 5.0.4 && < 5.1,

77+ constraints >= 0.10 && <0.14,

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

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

78 containers >= 0.6 && < 0.7,

79 containers >= 0.6 && < 0.7,

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

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

80 dependent-map >= 0.3 && < 0.5,

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

81 exception-transformers == 0.4.*,

82 exception-transformers == 0.4.*,

82 lens >= 4.7 && < 5,

83 lens >= 4.7 && < 5,

84+ mmorph >= 1.0 && < 1.2,

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

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

84 mtl >= 2.1 && < 2.3,

86 mtl >= 2.1 && < 2.3,

85 patch >= 0.0.1 && < 0.1,

87 patch >= 0.0.1 && < 0.1,

86 prim-uniq >= 0.1.0.1 && < 0.3,

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

87 primitive >= 0.5 && < 0.8,

89 primitive >= 0.5 && < 0.8,

88− profunctors >= 5.3 && < 5.6,

90+ profunctors >= 5.3 && < 5.7,

89 random == 1.1.*,

91 random == 1.1.*,

90 ref-tf == 0.4.*,

92 ref-tf == 0.4.*,

91 reflection == 2.1.*,

93 reflection == 2.1.*,

@@ -95,7 +97,7 @@ library

95 time >= 1.4 && < 1.10,

97 time >= 1.4 && < 1.10,

96 transformers >= 0.5.6.0 && < 0.6,

98 transformers >= 0.5.6.0 && < 0.6,

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

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

98− witherable >= 0.3 && < 0.4

100+ witherable >= 0.3 && < 0.5

101

100 if flag(split-these)

102 if flag(split-these)

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

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

@@ -184,7 +186,7 @@ library

184 dependent-sum >= 0.6 && < 0.8,

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

185 haskell-src-exts >= 1.16 && < 1.24,

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

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

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

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

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

188 exposed-modules:

190 exposed-modules:

189 Reflex.Dynamic.TH

191 Reflex.Dynamic.TH

190 other-extensions: TemplateHaskell

192 other-extensions: TemplateHaskell

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

256 , directory

258 , directory

257 , filepath

259 , filepath

258 , filemanip

260 , filemanip

261+ if impl(ghc >= 8.8)

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

263+ else

259− , hlint (< 2.1 || >= 2.2.2) && < 3

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

260 if impl(ghcjs)

265 if impl(ghcjs)

261 buildable: False

266 buildable: False

262

267

@@ -341,6 +346,14 @@ test-suite RequesterT

341 Reflex.Plan.Pure

346 Reflex.Plan.Pure

342 Test.Run

347 Test.Run

343

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+

344test-suite Adjustable

357test-suite Adjustable

345 default-language: Haskell2010

358 default-language: Haskell2010

346 type: exitcode-stdio-1.0

359 type: exitcode-stdio-1.0

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

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

@@ -48,7 +49,18 @@ import Reflex.TriggerEvent.Class

49-- | A basic implementation of 'BehaviorWriter'.

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

src/Reflex/Dynamic.hs+1−1

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

348--

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

350--

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

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

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

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

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+12−4

@@ -35,6 +35,7 @@ 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

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

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

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

99newtype 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 }

100− 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+ )

101

112

102-- | Run a 'EventWriterT' action.

113-- | Run a 'EventWriterT' action.

103runEventWriterT :: 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)

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

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

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

118 }

129 }

119

130

120−instance MonadTrans (EventWriterT t w) where

121− lift = EventWriterT . lift

122−

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

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

124 sample = lift . sample

132 sample = lift . sample

125

133

src/Reflex/Host/Headless.hs+11−9

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

7module Reflex.Host.Headless where

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

10+import Control.Monad (unless)

10import Control.Monad.Fix (MonadFix, fix)

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

11import Control.Monad.IO.Class (MonadIO, liftIO)

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

12import Control.Monad.Primitive (PrimMonad)

13import Control.Monad.Primitive (PrimMonad)

@@ -15,7 +16,7 @@ import Data.Dependent.Sum (DSum (..), (==>))

15import Data.Foldable (for_)

16import Data.Foldable (for_)

16import Data.Functor.Identity (Identity(..))

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

17import Data.IORef (IORef, readIORef)

18import Data.IORef (IORef, readIORef)

18−import Data.Maybe (catMaybes)

19+import Data.Maybe (catMaybes, fromMaybe)

19import Data.Traversable (for)

20import Data.Traversable (for)

21import Reflex

22import Reflex

@@ -82,32 +83,33 @@ runHeadlessApp guest =

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

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

83 mPostBuildTrigger <- readRef postBuildTriggerRef

84 mPostBuildTrigger <- readRef postBuildTriggerRef

85− -- When there is a subscriber to the post-build event, fire the event.

86− for_ mPostBuildTrigger $ \postBuildTrigger ->

87− fire [postBuildTrigger :=> Identity ()] $ pure ()

88−

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

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

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

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

91 -- to determine whether to terminate.

88 -- to determine whether to terminate.

92 shutdown <- subscribeEvent result

89 shutdown <- subscribeEvent result

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+

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

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

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

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

96 -- terminates.

97 -- terminates.

97− fix $ \loop -> do

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

98 -- Read the next event (blocking).

99 -- Read the next event (blocking).

99 ers <- liftIO $ readChan events

100 ers <- liftIO $ readChan events

100 stop <- do

101 stop <- do

101 -- Fire events that have subscribers.

102 -- Fire events that have subscribers.

102 fireEventTriggerRefs fc ers $

103 fireEventTriggerRefs fc ers $

103 -- Check if the shutdown 'Event' is firing.

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

104− readEvent shutdown >>= \case

105+ isFiring shutdown

105− Nothing -> pure False

106− Just _ -> pure True

107 if or stop

106 if or stop

108 then pure ()

107 then pure ()

109 else loop

108 else loop

110 where

109 where

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

111+ Nothing -> pure False

112+ Just _ -> pure True

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

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

112 -- and call the callback for the 'TriggerInvocation' of each.

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

113 fireEventTriggerRefs

115 fireEventTriggerRefs

src/Reflex/PerformEvent/Class.hs−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 #-}

src/Reflex/PostBuild/Base.hs−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 #-}

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+1−1

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

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

148 pull = Behavior_Profiled . pull . coerce

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

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

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

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

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

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

src/Reflex/Query/Base.hs+4

@@ -22,6 +22,7 @@ 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

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

239instance MonadTrans (QueryT t q) where

240instance MonadTrans (QueryT t q) where

240 lift = QueryT . lift . lift . lift

241 lift = QueryT . lift . lift . lift

241

242

243+instance MFunctor (QueryT t q) where

244+ hoist = mapQueryT

245+

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

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

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

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

244 primitive = lift . primitive

248 primitive = lift . primitive

src/Reflex/Requester/Base.hs+95−26

@@ -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,12 +51,14 @@ 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

58import Data.Dependent.Map (DMap)

62import Data.Dependent.Map (DMap)

59import qualified Data.Dependent.Map as DMap

63import qualified Data.Dependent.Map as DMap

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

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

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

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

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

87+emptyRequesterData :: RequesterData f

88+emptyRequesterData = RequesterData $ TagMap IntMap.empty

89+

83data RequesterDataKey a where

90data RequesterDataKey a where

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

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

85 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

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

87 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

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

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

90singletonRequesterData rdk v = case rdk of

97singletonRequesterData rdk v = case rdk of

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

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

92 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

93− 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+ }

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

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

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

97requesterDataToList (RequesterData m) = do

133requesterDataToList (RequesterData m) = do

98 k :=> Entry e <- tagMapToList m

134 k :=> Entry e <- tagMapToList m

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

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

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

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

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

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

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

105− MyTagType_Multi2 -> do

141+ MyTagType_Multi2 -> case _multi2Contents_dict e of

142+ Dict -> do

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

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

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

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

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

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

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

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

110 MyTagType_Multi3 -> do

147 MyTagType_Multi3 -> do

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

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

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

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

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

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

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

135 MyTagType_Single -> f request

172 MyTagType_Single -> f request

136 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

137− 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+ }

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

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

139

182

140-- | 'traverseRequesterData' with its arguments flipped

183-- | 'traverseRequesterData' with its arguments flipped

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

178type family EntryContents request a where

221type family EntryContents request a where

179 EntryContents request (Single a) = request a

222 EntryContents request (Single a) = request a

180 EntryContents request Multi = IntMap (RequesterData request)

223 EntryContents request Multi = IntMap (RequesterData request)

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

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

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

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

183

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+

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

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

185

233

186{-# INLINE singleEntry #-}

234{-# INLINE singleEntry #-}

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

309 return t

357 return t

310

358

311{-# INLINE responseFromTag #-}

359{-# INLINE responseFromTag #-}

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

313responseFromTag (MyTagWrap t) = do

361responseFromTag (MyTagWrap t) = do

314 responses :: EventSelectorInt t Any <- RequesterT ask

362 responses :: EventSelectorInt t Any <- RequesterT ask

315 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

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

317instance MonadTrans (RequesterT t request response) where

365instance MonadTrans (RequesterT t request response) where

318 lift = RequesterT . lift . lift

366 lift = RequesterT . lift . lift

319

367

368+instance MFunctor (RequesterT t request response) where

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

370+

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

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

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

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

322 performEvent_ = lift . performEvent_

373 performEvent_ = lift . performEvent_

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

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

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

437 responses = fanMap $ fmapCheap unpack response

488 responses = fanMap $ fmapCheap unpack response

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

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

439− unpack = unEntry

490+ unpack = _multi2Contents_values . unEntry

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

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

441− pack = Entry

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

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

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

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

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

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

459data Decoder rawResponse response =

510data Decoder rawResponse response =

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

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

461

512

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

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

464−-- incoming responses.

465matchResponsesWithRequests

513matchResponsesWithRequests

466 :: forall t rawRequest rawResponse request response m.

514 :: forall t rawRequest rawResponse request response m.

467 ( MonadFix m

515 ( MonadFix m

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

480 )

528 )

481 -- ^ 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

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

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

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

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

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

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

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

486 holdIncremental mempty $ leftmost

557 holdIncremental mempty $ leftmost

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

522 processIncoming

593 processIncoming

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

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

524 -- A map of outstanding expected responses

595 -- A map of outstanding expected responses

525− -> Event t (Int, rawResponse)

596+ -> Event t (Map Int rawResponse)

526 -- A incoming response paired with its identifying key

597 -- A incoming response paired with its identifying key

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

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

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

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

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

530 wf <- sample $ currentIncremental waitingFor

601 wf <- sample $ currentIncremental waitingFor

531− case Map.lookup n wf of

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

533− Just (Decoder k rspF) -> do

602+ let match rawRsp (Decoder k rspF) =

534− let rsp = rspF rawRsp

603+ let rsp = rspF rawRsp

535− return $ Just

536− ( singletonRequesterData k rsp

604+ in singletonRequesterData k rsp

537− , PatchMap $ Map.singleton n Nothing

605+ matches = Map.intersectionWith match rspMap wf

538− )

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

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

src/Reflex/Spider/Internal.hs+2−2

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

@@ -2775,7 +2775,7 @@ instance HasSpiderTimeline x => R.Reflex (SpiderTimeline x) where

2775 fanG e = R.EventSelectorG $ SpiderEvent . selectG (fanG (unSpiderEvent e))

2776 {-# INLINABLE mergeG #-}

2777 mergeG

2778− :: forall (k :: k2 -> *) q (v :: k2 -> *). GCompare k

2778+ :: forall k2 (k :: k2 -> *) q (v :: k2 -> *). GCompare k

2779 => (forall a. q a -> R.Event (SpiderTimeline x) (v a))

2780 -> DMap k q

2781 -> R.Event (SpiderTimeline x) (DMap k v)

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