mirror of
https://github.com/ilyakooo0/reflex.git
synced 2024-10-04 05:37:09 +03:00
Merge branch 'develop' into hlint
This commit is contained in:
commit
9a2aa06288
171
.travis.yml
Normal file
171
.travis.yml
Normal file
@ -0,0 +1,171 @@
|
||||
# This Travis job script has been generated by a script via
|
||||
#
|
||||
# haskell-ci '--config=cabal.haskell-ci' 'cabal.project'
|
||||
#
|
||||
# For more information, see https://github.com/haskell-CI/haskell-ci
|
||||
#
|
||||
# version: 0.3.20190814
|
||||
#
|
||||
language: c
|
||||
dist: xenial
|
||||
sudo: required
|
||||
git:
|
||||
# whether to recursively clone submodules
|
||||
submodules: false
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.cabal/packages
|
||||
- $HOME/.cabal/store
|
||||
before_cache:
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
|
||||
# remove files that are regenerated by 'cabal update'
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
|
||||
- rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
|
||||
- rm -rfv $CABALHOME/packages/head.hackage
|
||||
matrix:
|
||||
include:
|
||||
- compiler: ghcjs-8.4
|
||||
addons: {"apt":{"sources":["hvr-ghc"],"packages":["cabal-install-3.0"]}}
|
||||
- compiler: ghc-8.6.5
|
||||
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}
|
||||
- compiler: ghc-8.4.4
|
||||
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}
|
||||
- compiler: ghc-8.2.2
|
||||
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}
|
||||
- compiler: ghc-8.0.2
|
||||
addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}
|
||||
before_install:
|
||||
- |
|
||||
if [ "$TRAVIS_OS_NAME" = "linux" ]; then
|
||||
sudo add-apt-repository -y ppa:hvr/ghcjs;
|
||||
curl -s https://deb.nodesource.com/gpgkey/nodesource.gpg.key | sudo apt-key add -
|
||||
sudo apt-add-repository 'https://deb.nodesource.com/node_8.x xenial main'
|
||||
sudo apt-get update;
|
||||
sudo apt-get install $CC cabal-install-3.0 nodejs;
|
||||
fi
|
||||
- HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
|
||||
- WITHCOMPILER="-w $HC"
|
||||
- |
|
||||
if echo $CC | grep -q ghcjs; then
|
||||
GHCJS=true
|
||||
HC=${HC}js
|
||||
WITHCOMPILER="--ghcjs ${WITHCOMPILER}js"
|
||||
else
|
||||
GHCJS=false;
|
||||
fi
|
||||
- if $GHCJS ; then sudo apt-get install -y ghc-8.4.4 ; fi
|
||||
- if $GHCJS ; then PATH="/opt/ghc/8.4.4/bin:$PATH" ; fi
|
||||
- HCPKG="$HC-pkg"
|
||||
- unset CC
|
||||
- CABAL=/opt/ghc/bin/cabal
|
||||
- CABALHOME=$HOME/.cabal
|
||||
- export PATH="$CABALHOME/bin:$PATH"
|
||||
- TOP=$(pwd)
|
||||
- "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
|
||||
- echo $HCNUMVER
|
||||
- CABAL="$CABAL -vnormal+nowrap+markoutput"
|
||||
- set -o pipefail
|
||||
- |
|
||||
echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk
|
||||
echo 'BEGIN { state = "output"; }' >> .colorful.awk
|
||||
echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk
|
||||
echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk
|
||||
echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
|
||||
echo ' if (state == "cabal") {' >> .colorful.awk
|
||||
echo ' print blue($0)' >> .colorful.awk
|
||||
echo ' } else {' >> .colorful.awk
|
||||
echo ' print $0' >> .colorful.awk
|
||||
echo ' }' >> .colorful.awk
|
||||
echo '}' >> .colorful.awk
|
||||
- cat .colorful.awk
|
||||
- |
|
||||
color_cabal_output () {
|
||||
awk -f $TOP/.colorful.awk
|
||||
}
|
||||
- echo text | color_cabal_output
|
||||
install:
|
||||
- ${CABAL} --version
|
||||
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- node --version
|
||||
- echo $GHCJS
|
||||
- TEST=--enable-tests
|
||||
- BENCH=--enable-benchmarks
|
||||
- BENCH=--disable-benchmarks
|
||||
- HEADHACKAGE=false
|
||||
- rm -f $CABALHOME/config
|
||||
- |
|
||||
echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
|
||||
echo "remote-build-reporting: anonymous" >> $CABALHOME/config
|
||||
echo "write-ghc-environment-files: always" >> $CABALHOME/config
|
||||
echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
|
||||
echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
|
||||
echo "world-file: $CABALHOME/world" >> $CABALHOME/config
|
||||
echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
|
||||
echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
|
||||
echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
|
||||
echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
|
||||
echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
|
||||
echo "install-dirs user" >> $CABALHOME/config
|
||||
echo " prefix: $CABALHOME" >> $CABALHOME/config
|
||||
echo "repository hackage.haskell.org" >> $CABALHOME/config
|
||||
echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
|
||||
- cat $CABALHOME/config
|
||||
- rm -fv cabal.project cabal.project.local cabal.project.freeze
|
||||
- travis_retry ${CABAL} v2-update -v
|
||||
- if $GHCJS ; then (cd /tmp && ${CABAL} v2-install -w ghc-8.4.4 happy) ; fi
|
||||
# Generate cabal.project
|
||||
- rm -rf cabal.project cabal.project.local cabal.project.freeze
|
||||
- touch cabal.project
|
||||
- |
|
||||
echo "packages: ." >> cabal.project
|
||||
- |
|
||||
- cat cabal.project || true
|
||||
- cat cabal.project.local || true
|
||||
- if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
|
||||
- ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output
|
||||
- "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
|
||||
- rm cabal.project.freeze
|
||||
script:
|
||||
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
||||
# Packaging...
|
||||
- ${CABAL} v2-sdist all | color_cabal_output
|
||||
# Unpacking...
|
||||
- mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
|
||||
- cd ${DISTDIR} || false
|
||||
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
|
||||
- find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
|
||||
- PKGDIR_reflex="$(find . -maxdepth 1 -type d -regex '.*/reflex-[0-9.]*')"
|
||||
# Generate cabal.project
|
||||
- rm -rf cabal.project cabal.project.local cabal.project.freeze
|
||||
- touch cabal.project
|
||||
- |
|
||||
echo "packages: ${PKGDIR_reflex}" >> cabal.project
|
||||
- |
|
||||
- cat cabal.project || true
|
||||
- cat cabal.project.local || true
|
||||
# Building...
|
||||
# this builds all libraries and executables (without tests/benchmarks)
|
||||
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
|
||||
# Building with tests and benchmarks...
|
||||
# build & run tests, build benchmarks
|
||||
- ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
|
||||
# Testing...
|
||||
- if ! $GHCJS ; then ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi
|
||||
# cabal check...
|
||||
- (cd ${PKGDIR_reflex} && ${CABAL} -vnormal check)
|
||||
# haddock...
|
||||
- if ! $GHCJS ; then ${CABAL} v2-haddock $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output ; fi
|
||||
# Constraint sets
|
||||
- rm -rf cabal.project.local
|
||||
# Constraint set no-th
|
||||
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='reflex -use-template-haskell' all | color_cabal_output
|
||||
# Constraint set old-these
|
||||
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='these <1' all | color_cabal_output
|
||||
# Constraint set old-witherable
|
||||
- ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --constraint='witherable <0.3.2' all | color_cabal_output
|
||||
|
||||
# REGENDATA ["--config=cabal.haskell-ci","cabal.project"]
|
||||
# EOF
|
@ -5,6 +5,7 @@ Contributions and issue reports are encouraged and appreciated!
|
||||
- [Opening Issues](#opening-issues)
|
||||
- [Submitting Changes](#submitting-changes)
|
||||
- [Guidelines for Commit Messages](#guidelines-for-commit-messages)
|
||||
- [Guidelines for Pull Requests](#guidelines-for-pull-requests)
|
||||
- [Code Quality](#code-quality)
|
||||
- [Documentation](#documentation)
|
||||
|
||||
@ -30,6 +31,10 @@ One way to think about it is that your commit message should be able to complete
|
||||
#### Body
|
||||
For breaking changes, new features, refactors, or other major changes, the body of the commit message should describe the motivation behind the change in greater detail and may include references to the issue tracker. The body shouldn't repeat code/comments from the diff.
|
||||
|
||||
### Guidelines for Pull Requests
|
||||
|
||||
Wherever possible, pull requests should add a single feature or fix a single bug. Pull requests should not bundle several unrelated changes.
|
||||
|
||||
### Code Quality
|
||||
|
||||
#### Warnings
|
||||
@ -40,6 +45,10 @@ Your pull request should add no new warnings to the project. It should also gene
|
||||
|
||||
Make sure the project builds and that the tests pass! This will generally also be checked by CI before merge, but trying it yourself first means you'll catch problems earlier and your contribution can be merged that much sooner!
|
||||
|
||||
#### Dependencies
|
||||
|
||||
Include version bounds whenever adding a dependency to the library stanza of the cabal file. Note that libraries added to reflex.cabal also need to be added to default.nix.
|
||||
|
||||
### Documentation
|
||||
|
||||
#### In the code
|
||||
|
62
ChangeLog.md
62
ChangeLog.md
@ -2,20 +2,80 @@
|
||||
|
||||
## Unreleased
|
||||
|
||||
* Fix `holdDyn` so that it is lazy in its event argument
|
||||
* Data.WeakBag.traverse and Data.FastWeakBag.traverse have been
|
||||
renamed to Data.WeakBag.traverse_ and Data.FastWeakBag.traverse_
|
||||
respectively.
|
||||
|
||||
* Fixes a bug in `Reflex.Patch.MapWithMove.patchThatSortsMapWith` that was producing invalid `PatchMapWithMove`.
|
||||
|
||||
* Add missing `NotReady` instances:
|
||||
- `instance NotReady (SpiderTimeline x) (SpiderHost x)`
|
||||
- `instance HasSpiderTimeline x => NotReady (SpiderTimeline x) (PerformEventT (SpiderTimeline x) (SpiderHost x))`
|
||||
|
||||
## 0.6.2.4
|
||||
|
||||
* Update to monoidal-containers 0.6
|
||||
|
||||
## 0.6.2.3
|
||||
|
||||
* Add an upper-bound to witherable
|
||||
|
||||
## 0.6.2.2
|
||||
|
||||
* Support these >= 1. Add `split-these` flag to control whether to use new these/semialign combination or not.
|
||||
|
||||
* Update version bounds to fix some CI failures
|
||||
|
||||
* Add travis CI configuration
|
||||
|
||||
## 0.6.2.1
|
||||
|
||||
* Generalize `fan` to `fanG` to take a `DMap` with non-`Identity`
|
||||
functor:
|
||||
* `fan` to `fanG`
|
||||
* `EventSelectorG` for `fanG` result selector.
|
||||
|
||||
* Reduce the amount of unsafeCoerce in coercing newtypes under Event/Dynamic/Behavior.
|
||||
* Add fused ReaderIO for the purpose of coercion (ReaderT's third argument has nominal role preventing automated coerce)
|
||||
* Add incrementalCoercion/coerceIncremental to go with dynamicCoercion/coerceDynamic
|
||||
|
||||
* Generalize merging functions:
|
||||
`merge` to `mergeG`,
|
||||
`mergeIncremental` to `mergeIncrementalG`,
|
||||
`mergeIncrementalWithMove` to `mergeIncrementalWithMoveG`.
|
||||
|
||||
* Generalize distribute function:
|
||||
`distributeDMapOverDynPure` to `distributeDMapOverDynPureG`,
|
||||
|
||||
## 0.6.2.0
|
||||
|
||||
* Fix `holdDyn` so that it is lazy in its event argument
|
||||
These produce `DMap`s whose values needn't be `Identity`.
|
||||
|
||||
* Stop using the now-deprecated `*Tag` classes (e.g., `ShowTag`).
|
||||
|
||||
* Fix `holdDyn` so that it is lazy in its event argument.
|
||||
|
||||
## 0.6.1.0
|
||||
|
||||
* Re-export all of `Data.Map.Monoidal`
|
||||
|
||||
* Fix `QueryT` and `RequesterT` tests
|
||||
|
||||
## 0.6.0.0 -- 2019-03-20
|
||||
|
||||
* Deprecate `FunctorMaybe` in favor of `Data.Witherable.Filterable`. We still export `fmapMaybe`, `ffilter`, etc., but they all rely on `Filterable` now.
|
||||
|
||||
* Rename `MonadDynamicWriter` to `DynamicWriter` and add a deprecation for the old name.
|
||||
|
||||
* Remove many deprecated functions.
|
||||
|
||||
* Add a `Num` instance for `Dynamic`.
|
||||
|
||||
* Add `matchRequestsWithResponses` to make it easier to use `Requester` with protocols that don't do this matching for you.
|
||||
|
||||
* Add `withRequesterT` to map functions over the request and response of a `RequesterT`.
|
||||
|
||||
* Suppress nil patches in `QueryT` as an optimization. The `Query` type must now have an `Eq` instance.
|
||||
|
||||
* Add `throttleBatchWithLag` to `Reflex.Time`. See that module for details.
|
||||
|
25
Quickref.md
25
Quickref.md
@ -198,7 +198,7 @@ For Events, the returned Event fires whenever the latest Event supplied by the w
|
||||
The functions mentioned above are used to create a static FRP network.
|
||||
There are additional typeclasses that can be used to modify the FRP network, to have it interact with IO action, or to introspect the building of the network.
|
||||
|
||||
Th typeclasses and their associated annotations include:
|
||||
The typeclasses and their associated annotations include:
|
||||
|
||||
- `PostBuild`
|
||||
Fire an Event when an FRP network has been set up.
|
||||
@ -206,7 +206,7 @@ Th typeclasses and their associated annotations include:
|
||||
[B] -- Function runs in any monad supporting PostBuild
|
||||
```
|
||||
|
||||
- `Adjustable`
|
||||
- `Adjustable`
|
||||
Use Events to add or remove pieces of an FRP network.
|
||||
```haskell
|
||||
[A] -- Function runs in any monad supporting Adjustable
|
||||
@ -271,7 +271,7 @@ Th typeclasses and their associated annotations include:
|
||||
```haskell
|
||||
-- Run side-effecting actions in Event when it occurs; returned Event contains
|
||||
-- results. Side effects run in the (Performable m) monad which is associated with
|
||||
-- the (PerformEvent t m) typeclass constraint.
|
||||
-- the (PerformEvent t m) typeclass constraint.
|
||||
-- This allows for working with IO when a ((MonadIO (Performable m)) constraint is available.
|
||||
[P] performEvent :: Event (Performable m a ) -> m (Event a)
|
||||
|
||||
@ -295,17 +295,20 @@ Th typeclasses and their associated annotations include:
|
||||
## Networks
|
||||
|
||||
```haskell
|
||||
-- Functions from Reflex.Network used to deal with Dynamics/Events carrying (m a)
|
||||
-- Functions from Reflex.Adjustable / Reflex.Network used to deal with Dynamics/Events carrying (m a)
|
||||
|
||||
-- Given a Dynamic of network-creating actions, create a network that is recreated whenever the Dynamic updates.
|
||||
-- The returned Event of network results occurs when the Dynamic does. Note: Often, the type a is an Event,
|
||||
[A] runWithReplace :: m a -> Event t (m b) -> m (a, Event t b)
|
||||
|
||||
-- Given a Dynamic of network-creating actions, create a network that is recreated whenever the Dynamic updates.
|
||||
-- The returned Event of network results occurs when the Dynamic does. Note: Often, the type a is an Event,
|
||||
-- in which case the return value is an Event-of-Events that would typically be flattened (via switchHold).
|
||||
[P,A] networkView :: Dynamic (m a) -> m (Event a)
|
||||
[P,A] networkView :: Dynamic (m a) -> m (Event a)
|
||||
|
||||
-- Given an initial network and an Event of network-creating actions, create a network that is recreated whenever the
|
||||
-- Event fires. The returned Dynamic of network results occurs when the Event does. Note: Often, the type a is an
|
||||
-- Given an initial network and an Event of network-creating actions, create a network that is recreated whenever the
|
||||
-- Event fires. The returned Dynamic of network results occurs when the Event does. Note: Often, the type a is an
|
||||
-- Event, in which case the return value is a Dynamic-of-Events that would typically be flattened.
|
||||
[H,A] networkHold :: m a -> Event (m a) -> m (Dynamic a)
|
||||
[H,A] networkHold :: m a -> Event (m a) -> m (Dynamic a)
|
||||
|
||||
-- Render a placeholder network to be shown while another network is not yet done building
|
||||
[P,A] untilReady :: m a -> m b -> m (a, Event b)
|
||||
[P,A] untilReady :: m a -> m b -> m (a, Event b)
|
||||
```
|
||||
|
16
cabal.haskell-ci
Normal file
16
cabal.haskell-ci
Normal file
@ -0,0 +1,16 @@
|
||||
distribution: xenial
|
||||
benchmarks: False
|
||||
unconstrained: False
|
||||
installed: -all
|
||||
|
||||
-- https://github.com/haskell/cabal/issues/6106
|
||||
install-dependencies: False
|
||||
|
||||
constraint-set no-th
|
||||
constraints: reflex -use-template-haskell
|
||||
|
||||
constraint-set old-these
|
||||
constraints: these <1
|
||||
|
||||
constraint-set old-witherable
|
||||
constraints: witherable <0.3.2
|
1
cabal.project
Normal file
1
cabal.project
Normal file
@ -0,0 +1 @@
|
||||
packages: .
|
1
cabal.project.freeze
Normal file
1
cabal.project.freeze
Normal file
@ -0,0 +1 @@
|
||||
constraints: any.text < 1.2.4.0
|
39
default.nix
39
default.nix
@ -1,39 +0,0 @@
|
||||
{ mkDerivation, ghc, base, bifunctors, containers, deepseq
|
||||
, dependent-map, dependent-sum, exception-transformers
|
||||
, haskell-src-exts, haskell-src-meta, hlint, lens, MemoTrie
|
||||
, monad-control, mtl, primitive, random, ref-tf
|
||||
, semigroupoids , semigroups, split, stdenv, stm, syb
|
||||
, template-haskell , these, time, transformers
|
||||
, transformers-compat, unbounded-delays, prim-uniq
|
||||
, data-default, filepath, directory, filemanip, ghcjs-base
|
||||
, monoidal-containers, witherable
|
||||
, useTemplateHaskell ? true
|
||||
}:
|
||||
mkDerivation {
|
||||
pname = "reflex";
|
||||
version = "0.6.1";
|
||||
src = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [ ".git" "dist" ])) ./.;
|
||||
libraryHaskellDepends = [
|
||||
base bifunctors containers dependent-map dependent-sum
|
||||
exception-transformers lens
|
||||
MemoTrie monad-control mtl primitive ref-tf semigroupoids
|
||||
semigroups stm syb template-haskell these transformers
|
||||
transformers-compat prim-uniq
|
||||
base bifunctors containers deepseq dependent-map dependent-sum
|
||||
mtl ref-tf split transformers data-default
|
||||
random time unbounded-delays monoidal-containers witherable
|
||||
] ++ (if ghc.isGhcjs or false then [
|
||||
ghcjs-base
|
||||
] else []) ++ (if !useTemplateHaskell then [] else [
|
||||
haskell-src-exts haskell-src-meta
|
||||
]);
|
||||
testHaskellDepends = if ghc.isGhcjs or false then [] else [
|
||||
hlint filepath directory filemanip
|
||||
];
|
||||
configureFlags = if useTemplateHaskell then [] else [
|
||||
"-f-use-template-haskell"
|
||||
];
|
||||
homepage = "https://github.com/reflex-frp/reflex";
|
||||
description = "Higher-order Functional Reactive Programming";
|
||||
license = stdenv.lib.licenses.bsd3;
|
||||
}
|
7
dep/reflex-platform/default.nix
Normal file
7
dep/reflex-platform/default.nix
Normal file
@ -0,0 +1,7 @@
|
||||
# DO NOT HAND-EDIT THIS FILE
|
||||
import ((import <nixpkgs> {}).fetchFromGitHub (
|
||||
let json = builtins.fromJSON (builtins.readFile ./github.json);
|
||||
in { inherit (json) owner repo rev sha256;
|
||||
private = json.private or false;
|
||||
}
|
||||
))
|
7
dep/reflex-platform/github.json
Normal file
7
dep/reflex-platform/github.json
Normal file
@ -0,0 +1,7 @@
|
||||
{
|
||||
"owner": "reflex-frp",
|
||||
"repo": "reflex-platform",
|
||||
"branch": "develop",
|
||||
"rev": "e7b76dd552a10916c7d8702c11292dac4f4299ea",
|
||||
"sha256": "0s1183arrwldcs50qhzgnv94v24n9bgq6dfq64wp0a3q2nzyvgwh"
|
||||
}
|
29
hydra.json
29
hydra.json
@ -1,29 +0,0 @@
|
||||
{
|
||||
"enabled": 1,
|
||||
"hidden": true,
|
||||
"description": "Jobsets",
|
||||
"nixexprinput": "src",
|
||||
"nixexprpath": "jobsets.nix",
|
||||
"checkinterval": 300,
|
||||
"schedulingshares": 100,
|
||||
"enableemail": false,
|
||||
"emailoverride": "",
|
||||
"keepnr": 10,
|
||||
"inputs": {
|
||||
"src": {
|
||||
"type": "git",
|
||||
"value": "https://github.com/reflex-frp/reflex.git develop",
|
||||
"emailresponsible": false
|
||||
},
|
||||
"nixpkgs": {
|
||||
"type": "git",
|
||||
"value": "https://github.com/NixOS/nixpkgs-channels nixos-unstable",
|
||||
"emailresponsible": false
|
||||
},
|
||||
"prs": {
|
||||
"type": "githubpulls",
|
||||
"value": "reflex-frp reflex",
|
||||
"emailresponsible": false
|
||||
}
|
||||
}
|
||||
}
|
70
jobsets.nix
70
jobsets.nix
@ -1,70 +0,0 @@
|
||||
{ prs }:
|
||||
|
||||
let
|
||||
pkgs = (import ./reflex-platform.nix {}).nixpkgs;
|
||||
mkFetchGithub = value: {
|
||||
inherit value;
|
||||
type = "git";
|
||||
emailresponsible = false;
|
||||
};
|
||||
in
|
||||
with pkgs.lib;
|
||||
let
|
||||
defaults = jobs: {
|
||||
inherit (jobs) description;
|
||||
enabled = 1;
|
||||
hidden = false;
|
||||
keepnr = 10;
|
||||
schedulingshares = 100;
|
||||
checkinterval = 120;
|
||||
enableemail = false;
|
||||
emailoverride = "";
|
||||
nixexprinput = "reflex";
|
||||
nixexprpath = "release.nix";
|
||||
inputs = jobs.inputs // {
|
||||
nixpkgs = {
|
||||
type = "git";
|
||||
value = "https://github.com/NixOS/nixpkgs-channels nixos-unstable";
|
||||
emailresponsible = false;
|
||||
};
|
||||
config = {
|
||||
type = "nix";
|
||||
value = "{ android_sdk.accept_license = true; }";
|
||||
emailresponsible = false;
|
||||
};
|
||||
};
|
||||
};
|
||||
branchJobset = branch: defaults {
|
||||
description = "reflex-${branch}";
|
||||
inputs = {
|
||||
reflex = {
|
||||
value = "https://github.com/reflex-frp/reflex ${branch}";
|
||||
type = "git";
|
||||
emailresponsible = false;
|
||||
};
|
||||
};
|
||||
};
|
||||
makePr = num: info: {
|
||||
name = "reflex-pr-${num}";
|
||||
value = defaults {
|
||||
description = "#${num}: ${info.title}";
|
||||
inputs = {
|
||||
reflex = {
|
||||
#NOTE: This should really use "pull/${num}/merge"; however, GitHub's
|
||||
#status checks only operate on PR heads. This creates a race
|
||||
#condition, which can currently only be solved by requiring PRs to be
|
||||
#up to date before they're merged. See
|
||||
#https://github.com/isaacs/github/issues/1002
|
||||
value = "https://github.com/reflex-frp/reflex pull/${num}/head";
|
||||
type = "git";
|
||||
emailresponsible = false;
|
||||
};
|
||||
};
|
||||
};
|
||||
};
|
||||
processedPrs = mapAttrs' makePr (builtins.fromJSON (builtins.readFile prs));
|
||||
jobsetsAttrs = processedPrs //
|
||||
genAttrs ["develop"] branchJobset;
|
||||
in {
|
||||
jobsets = pkgs.writeText "spec.json" (builtins.toJSON jobsetsAttrs);
|
||||
}
|
@ -1,8 +0,0 @@
|
||||
let
|
||||
reflex-platform-src = (import <nixpkgs> {}).fetchFromGitHub {
|
||||
owner = "reflex-frp";
|
||||
repo = "reflex-platform";
|
||||
rev = "384cd850f3adf1d404bced2424b5f6efb0f415f2";
|
||||
sha256 = "1ws77prqx8khmp8j6br1ij4k2v4dlgv170r9fmg0p1jivfbn8y9d";
|
||||
};
|
||||
in import reflex-platform-src
|
96
reflex.cabal
96
reflex.cabal
@ -1,5 +1,5 @@
|
||||
Name: reflex
|
||||
Version: 0.6.1
|
||||
Version: 0.6.2.4
|
||||
Synopsis: Higher-order Functional Reactive Programming
|
||||
Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
|
||||
License: BSD3
|
||||
@ -17,6 +17,10 @@ extra-source-files:
|
||||
Quickref.md
|
||||
ChangeLog.md
|
||||
|
||||
tested-with:
|
||||
GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5,
|
||||
GHCJS ==8.4
|
||||
|
||||
flag use-reflex-optimizer
|
||||
description: Use the GHC plugin Reflex.Optimizer on some of the modules in the package. This is still experimental.
|
||||
default: False
|
||||
@ -37,38 +41,51 @@ flag fast-weak
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
flag split-these
|
||||
description: Use split these/semialign packages
|
||||
manual: False
|
||||
default: True
|
||||
|
||||
library
|
||||
hs-source-dirs: src
|
||||
build-depends:
|
||||
MemoTrie == 0.6.*,
|
||||
base >= 4.9 && < 4.13,
|
||||
bifunctors >= 5.2 && < 5.6,
|
||||
comonad,
|
||||
containers >= 0.5 && < 0.7,
|
||||
comonad >= 5.0.4 && < 5.1,
|
||||
constraints-extras >= 0.3 && < 0.4,
|
||||
containers >= 0.6 && < 0.7,
|
||||
data-default >= 0.5 && < 0.8,
|
||||
dependent-map >= 0.2.4 && < 0.3,
|
||||
dependent-map >= 0.3 && < 0.4,
|
||||
exception-transformers == 0.4.*,
|
||||
profunctors >= 5.3 && < 5.5,
|
||||
lens >= 4.7 && < 5,
|
||||
monad-control >= 1.0.1 && < 1.1,
|
||||
monoidal-containers == 0.4.*,
|
||||
mtl >= 2.1 && < 2.3,
|
||||
prim-uniq >= 0.1.0.1 && < 0.2,
|
||||
primitive >= 0.5 && < 0.7,
|
||||
primitive >= 0.5 && < 0.8,
|
||||
profunctors,
|
||||
random == 1.1.*,
|
||||
ref-tf == 0.4.*,
|
||||
reflection == 2.1.*,
|
||||
semigroupoids >= 4.0 && < 6,
|
||||
semigroups >= 0.16 && < 0.19,
|
||||
stm >= 2.4 && < 2.6,
|
||||
syb >= 0.5 && < 0.8,
|
||||
these >= 0.4 && < 0.9,
|
||||
time >= 1.4 && < 1.9,
|
||||
transformers >= 0.2,
|
||||
transformers-compat >= 0.3,
|
||||
transformers >= 0.5.6.0 && < 0.6,
|
||||
unbounded-delays >= 0.1.0.0 && < 0.2,
|
||||
witherable >= 0.2 && < 0.4
|
||||
witherable >= 0.3 && < 0.3.2
|
||||
|
||||
if flag(split-these)
|
||||
build-depends: these >= 1 && <1.1,
|
||||
semialign >=1 && <1.2,
|
||||
monoidal-containers >= 0.6 && < 0.7
|
||||
else
|
||||
build-depends: these >= 0.4 && <0.9,
|
||||
monoidal-containers == 0.4.0.0
|
||||
|
||||
exposed-modules:
|
||||
Control.Monad.ReaderIO
|
||||
Data.AppendMap,
|
||||
Data.FastMutableIntMap,
|
||||
Data.FastWeakBag,
|
||||
@ -133,7 +150,7 @@ library
|
||||
if flag(use-template-haskell)
|
||||
cpp-options: -DUSE_TEMPLATE_HASKELL
|
||||
build-depends:
|
||||
dependent-sum >= 0.3 && < 0.5,
|
||||
dependent-sum >= 0.6 && < 0.7,
|
||||
haskell-src-exts >= 1.16 && < 1.22,
|
||||
haskell-src-meta >= 0.6 && < 0.9,
|
||||
template-haskell >= 2.9 && < 2.15
|
||||
@ -142,7 +159,7 @@ library
|
||||
other-extensions: TemplateHaskell
|
||||
else
|
||||
build-depends:
|
||||
dependent-sum == 0.4.*
|
||||
dependent-sum >= 0.6 && < 0.7
|
||||
|
||||
if flag(fast-weak) && impl(ghcjs)
|
||||
cpp-options: -DGHCJS_FAST_WEAK
|
||||
@ -159,14 +176,14 @@ test-suite semantics
|
||||
base,
|
||||
bifunctors,
|
||||
containers,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
deepseq,
|
||||
dependent-map,
|
||||
dependent-sum,
|
||||
mtl,
|
||||
ref-tf,
|
||||
reflex,
|
||||
split,
|
||||
transformers >= 0.3
|
||||
transformers
|
||||
other-modules:
|
||||
Reflex.Bench.Focused
|
||||
Reflex.Plan.Pure
|
||||
@ -185,7 +202,7 @@ test-suite CrossImpl
|
||||
containers,
|
||||
dependent-map,
|
||||
dependent-sum,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
deepseq,
|
||||
mtl,
|
||||
transformers,
|
||||
ref-tf,
|
||||
@ -204,7 +221,7 @@ test-suite hlint
|
||||
, directory
|
||||
, filepath
|
||||
, filemanip
|
||||
, hlint
|
||||
, hlint < 2.1 || >= 2.2.2
|
||||
if impl(ghcjs)
|
||||
buildable: False
|
||||
|
||||
@ -214,7 +231,7 @@ test-suite EventWriterT
|
||||
hs-source-dirs: test
|
||||
build-depends: base
|
||||
, containers
|
||||
, deepseq >= 1.3 && < 1.5
|
||||
, deepseq
|
||||
, dependent-map
|
||||
, dependent-sum
|
||||
, lens
|
||||
@ -223,6 +240,10 @@ test-suite EventWriterT
|
||||
, transformers
|
||||
, reflex
|
||||
, ref-tf
|
||||
|
||||
if flag(split-these)
|
||||
build-depends: these-lens
|
||||
|
||||
other-modules:
|
||||
Reflex.Test
|
||||
Reflex.TestPlan
|
||||
@ -230,13 +251,14 @@ test-suite EventWriterT
|
||||
Reflex.Plan.Pure
|
||||
Test.Run
|
||||
|
||||
|
||||
test-suite RequesterT
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: RequesterT.hs
|
||||
hs-source-dirs: test
|
||||
build-depends: base
|
||||
, containers
|
||||
, deepseq >= 1.3 && < 1.5
|
||||
, deepseq
|
||||
, dependent-sum
|
||||
, dependent-map
|
||||
, lens
|
||||
@ -245,9 +267,14 @@ test-suite RequesterT
|
||||
, transformers
|
||||
, reflex
|
||||
, ref-tf
|
||||
|
||||
if flag(split-these)
|
||||
build-depends: these-lens
|
||||
|
||||
other-modules:
|
||||
Reflex.TestPlan
|
||||
Reflex.Plan.Pure
|
||||
Test.Run
|
||||
|
||||
test-suite QueryT
|
||||
type: exitcode-stdio-1.0
|
||||
@ -257,15 +284,18 @@ test-suite QueryT
|
||||
, containers
|
||||
, dependent-map
|
||||
, dependent-sum
|
||||
, deepseq >= 1.3 && < 1.5
|
||||
, deepseq
|
||||
, lens
|
||||
, monoidal-containers
|
||||
, mtl
|
||||
, ref-tf
|
||||
, reflex
|
||||
, semigroups
|
||||
, these
|
||||
, transformers
|
||||
|
||||
if flag(split-these)
|
||||
build-depends: semialign, these-lens
|
||||
|
||||
other-modules:
|
||||
Test.Run
|
||||
Reflex.TestPlan
|
||||
@ -280,14 +310,16 @@ test-suite GC-Semantics
|
||||
, containers
|
||||
, dependent-sum
|
||||
, dependent-map
|
||||
, deepseq >= 1.3 && < 1.5
|
||||
, deepseq
|
||||
, mtl
|
||||
, these
|
||||
, transformers
|
||||
, reflex
|
||||
, ref-tf
|
||||
if impl(ghc < 8)
|
||||
build-depends: semigroups
|
||||
|
||||
if flag(split-these)
|
||||
build-depends: semialign
|
||||
|
||||
other-modules:
|
||||
Reflex.Plan.Pure
|
||||
Reflex.Plan.Reflex
|
||||
@ -300,7 +332,7 @@ test-suite rootCleanup
|
||||
hs-source-dirs: test
|
||||
build-depends: base
|
||||
, containers
|
||||
, deepseq >= 1.3 && < 1.5
|
||||
, deepseq
|
||||
, dependent-sum
|
||||
, mtl
|
||||
, reflex
|
||||
@ -319,8 +351,8 @@ benchmark spider-bench
|
||||
build-depends:
|
||||
base,
|
||||
containers,
|
||||
criterion >= 1.1 && < 1.6,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
criterion,
|
||||
deepseq,
|
||||
dependent-map,
|
||||
dependent-sum,
|
||||
ref-tf,
|
||||
@ -329,7 +361,7 @@ benchmark spider-bench
|
||||
reflex,
|
||||
split,
|
||||
stm,
|
||||
transformers >= 0.3
|
||||
transformers
|
||||
other-modules:
|
||||
Reflex.TestPlan
|
||||
Reflex.Plan.Reflex
|
||||
@ -343,9 +375,9 @@ benchmark saulzar-bench
|
||||
ghc-options: -Wall -O2 -rtsopts -threaded
|
||||
build-depends:
|
||||
base,
|
||||
containers >= 0.5 && < 0.7,
|
||||
criterion >= 1.1 && < 1.6,
|
||||
deepseq >= 1.3 && < 1.5,
|
||||
containers,
|
||||
criterion,
|
||||
deepseq,
|
||||
dependent-map,
|
||||
dependent-sum,
|
||||
loch-th,
|
||||
@ -357,7 +389,7 @@ benchmark saulzar-bench
|
||||
split,
|
||||
stm,
|
||||
time,
|
||||
transformers >= 0.3
|
||||
transformers
|
||||
other-modules:
|
||||
Reflex.TestPlan
|
||||
Reflex.Plan.Reflex
|
||||
|
60
release.nix
60
release.nix
@ -1,9 +1,55 @@
|
||||
{ rp ? import ./reflex-platform.nix {}
|
||||
{ reflex-platform-fun ? import ./dep/reflex-platform
|
||||
}:
|
||||
|
||||
let
|
||||
inherit (rp.nixpkgs) lib;
|
||||
compilers = ["ghc8_4" "ghc8_0" "ghcjs8_4" "ghcjs8_0"];
|
||||
in lib.genAttrs compilers (ghc: {
|
||||
reflex-useTemplateHaskell = rp.${ghc}.callPackage ./. { useTemplateHaskell = true; };
|
||||
reflex = rp.${ghc}.callPackage ./. { useTemplateHaskell = false; };
|
||||
})
|
||||
native-reflex-platform = reflex-platform-fun {};
|
||||
inherit (native-reflex-platform.nixpkgs) lib;
|
||||
systems = ["x86_64-linux" "x86_64-darwin"];
|
||||
|
||||
perPlatform = lib.genAttrs systems (system: let
|
||||
reflex-platform = reflex-platform-fun { inherit system; };
|
||||
compilers = [
|
||||
"ghc"
|
||||
"ghcjs"
|
||||
] ++ lib.optionals (reflex-platform.androidSupport) [
|
||||
"ghcAndroidAarch64"
|
||||
"ghcAndroidAarch32"
|
||||
] ++ lib.optionals (reflex-platform.iosSupport) [
|
||||
"ghcIosAarch64"
|
||||
];
|
||||
variations = map (v: "reflex" + v) [
|
||||
"-dontUseTemplateHaskell"
|
||||
""
|
||||
];
|
||||
compilerPkgs = lib.genAttrs compilers (ghc: let
|
||||
variationPkgs = lib.genAttrs variations (variation: let
|
||||
reflex-platform = reflex-platform-fun {
|
||||
inherit system;
|
||||
__useTemplateHaskell = variation == "reflex"; # TODO hack
|
||||
haskellOverlays = [
|
||||
# Use this package's source for reflex
|
||||
(self: super: {
|
||||
_dep = super._dep // {
|
||||
reflex = builtins.filterSource (path: type: !(builtins.elem (baseNameOf path) [
|
||||
"release.nix"
|
||||
".git"
|
||||
"dist"
|
||||
])) ./.;
|
||||
};
|
||||
})
|
||||
];
|
||||
};
|
||||
in reflex-platform.${ghc}.reflex);
|
||||
in variationPkgs // {
|
||||
cache = reflex-platform.pinBuildInputs "reflex-${system}-${ghc}"
|
||||
(builtins.attrValues variationPkgs);
|
||||
});
|
||||
in compilerPkgs // {
|
||||
cache = reflex-platform.pinBuildInputs "reflex-${system}"
|
||||
(map (a: a.cache) (builtins.attrValues compilerPkgs));
|
||||
});
|
||||
|
||||
metaCache = native-reflex-platform.pinBuildInputs "reflex-everywhere"
|
||||
(map (a: a.cache) (builtins.attrValues perPlatform));
|
||||
|
||||
in perPlatform // { inherit metaCache; }
|
||||
|
60
src/Control/Monad/ReaderIO.hs
Normal file
60
src/Control/Monad/ReaderIO.hs
Normal file
@ -0,0 +1,60 @@
|
||||
{-# language RoleAnnotations #-}
|
||||
{-# language MultiParamTypeClasses #-}
|
||||
{-# language FlexibleInstances #-}
|
||||
{-# language CPP #-}
|
||||
module Control.Monad.ReaderIO
|
||||
(
|
||||
ReaderIO (..)
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Monad.Fix
|
||||
#if MIN_VERSION_base(4,10,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Monad
|
||||
import Control.Monad.Reader.Class
|
||||
import Control.Monad.IO.Class
|
||||
|
||||
-- | An approximate clone of @RIO@ from the @rio@ package, but not based on
|
||||
-- @ReaderT@. The trouble with @ReaderT@ is that its third type argument has a
|
||||
-- @nominal@ role, so we can't coerce through it when it's wrapped in some
|
||||
-- other @data@ type. Ugh.
|
||||
newtype ReaderIO e a = ReaderIO { runReaderIO :: e -> IO a }
|
||||
type role ReaderIO representational representational
|
||||
|
||||
instance Functor (ReaderIO e) where
|
||||
fmap = liftM
|
||||
{-# INLINE fmap #-}
|
||||
a <$ m = m >> pure a
|
||||
{-# INLINE (<$) #-}
|
||||
|
||||
instance Applicative (ReaderIO e) where
|
||||
pure a = ReaderIO $ \_ -> pure a
|
||||
{-# INLINE pure #-}
|
||||
(<*>) = ap
|
||||
{-# INLINE (<*>) #-}
|
||||
#if MIN_VERSION_base(4,10,0)
|
||||
liftA2 = liftM2
|
||||
{-# INLINE liftA2 #-}
|
||||
#endif
|
||||
(*>) = (>>)
|
||||
{-# INLINE (*>) #-}
|
||||
|
||||
instance Monad (ReaderIO e) where
|
||||
ReaderIO q >>= f = ReaderIO $ \e -> q e >>= \a -> runReaderIO (f a) e
|
||||
{-# INLINE (>>=) #-}
|
||||
|
||||
instance MonadFix (ReaderIO e) where
|
||||
mfix f = ReaderIO $ \e -> mfix $ \r -> runReaderIO (f r) e
|
||||
{-# INLINE mfix #-}
|
||||
|
||||
instance MonadIO (ReaderIO e) where
|
||||
liftIO m = ReaderIO $ \_ -> m
|
||||
{-# INLINE liftIO #-}
|
||||
|
||||
instance MonadReader e (ReaderIO e) where
|
||||
ask = ReaderIO pure
|
||||
{-# INLINE ask #-}
|
||||
local f (ReaderIO m) = ReaderIO (m . f)
|
||||
{-# INLINE local #-}
|
@ -32,6 +32,8 @@ import qualified Data.Map as Map (showTree, showTreeWith)
|
||||
#endif
|
||||
import qualified Data.Witherable as W
|
||||
import Data.Map.Monoidal
|
||||
import qualified Data.Map.Monoidal as MonoidalMap
|
||||
|
||||
|
||||
{-# DEPRECATED AppendMap "Use 'MonoidalMap' instead" #-}
|
||||
-- | AppendMap is a synonym for 'Data.Map.Monoidal.MonoidalMap'
|
||||
@ -46,8 +48,10 @@ _unAppendMap = getMonoidalMap
|
||||
pattern AppendMap :: Map k v -> MonoidalMap k v
|
||||
pattern AppendMap m = MonoidalMap m
|
||||
|
||||
#if !MIN_VERSION_witherable(0,3,2)
|
||||
instance W.Filterable (MonoidalMap k) where
|
||||
mapMaybe = mapMaybe
|
||||
mapMaybe = MonoidalMap.mapMaybe
|
||||
#endif
|
||||
|
||||
-- | Deletes a key, returning 'Nothing' if the result is empty.
|
||||
nonEmptyDelete :: Ord k => k -> MonoidalMap k a -> Maybe (MonoidalMap k a)
|
||||
|
@ -18,6 +18,7 @@ module Data.FastWeakBag
|
||||
, isEmpty
|
||||
, insert
|
||||
, traverse
|
||||
, traverse_
|
||||
, remove
|
||||
-- * Internal functions
|
||||
-- These will not always be available.
|
||||
@ -116,14 +117,14 @@ foreign import javascript unsafe "(function(){ for(var i = 0; i < $1.tickets.len
|
||||
isEmpty bag = {-# SCC "isEmpty" #-} IntMap.null <$> readIORef (_weakBag_children bag)
|
||||
#endif
|
||||
|
||||
{-# INLINE traverse #-}
|
||||
{-# INLINE traverse_ #-}
|
||||
-- | Visit every node in the given list. If new nodes are appended during the
|
||||
-- traversal, they will not be visited. Every live node that was in the list
|
||||
-- when the traversal began will be visited exactly once; however, no guarantee
|
||||
-- is made about the order of the traversal.
|
||||
traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
|
||||
traverse_ :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
|
||||
#ifdef GHCJS_FAST_WEAK
|
||||
traverse wb f = do
|
||||
traverse_ wb f = do
|
||||
let go cursor = when (not $ js_isNull cursor) $ do
|
||||
val <- liftIO $ js_getTicketValue cursor
|
||||
f $ unsafeFromRawJSVal val
|
||||
@ -134,13 +135,17 @@ foreign import javascript unsafe "$r = $1.val;" js_getTicketValue :: JSVal -> IO
|
||||
--TODO: Fix the race condition where if a cursor is deleted (presumably using 'remove', below) while we're holding it, it can't find its way back to the correct bag
|
||||
foreign import javascript unsafe "(function(){ for(var i = $1.pos - 1; i >= 0; i--) { if($1.bag.tickets[i] !== null) { return $1.bag.tickets[i]; } }; return null; })()" js_getNext :: FastWeakBagTicket a -> IO JSVal --TODO: Clean up as we go along so this isn't O(n) every time -- Result can be null or a FastWeakBagTicket a
|
||||
#else
|
||||
traverse (FastWeakBag _ children) f = {-# SCC "traverse" #-} do
|
||||
traverse_ (FastWeakBag _ children) f = {-# SCC "traverse_" #-} do
|
||||
cs <- liftIO $ readIORef children
|
||||
forM_ cs $ \c -> do
|
||||
ma <- liftIO $ deRefWeak c
|
||||
mapM_ f ma
|
||||
#endif
|
||||
|
||||
{-# DEPRECATED traverse "Use 'traverse_' instead" #-}
|
||||
traverse :: forall a m. MonadIO m => FastWeakBag a -> (a -> m ()) -> m ()
|
||||
traverse = traverse_
|
||||
|
||||
-- | Remove an item from the 'FastWeakBag'; does nothing if invoked multiple times
|
||||
-- on the same 'FastWeakBagTicket'.
|
||||
{-# INLINE remove #-}
|
||||
|
@ -51,8 +51,7 @@ import Data.IntMap (IntMap)
|
||||
import qualified Data.IntMap as IntMap
|
||||
import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Some (Some)
|
||||
import qualified Data.Some as Some
|
||||
import Data.Some (Some(Some))
|
||||
import Data.These
|
||||
import Data.Typeable hiding (Refl)
|
||||
|
||||
@ -78,9 +77,6 @@ deriving instance Read k => Read (Const2 k v v)
|
||||
instance Show k => GShow (Const2 k v) where
|
||||
gshowsPrec n x@(Const2 _) = showsPrec n x
|
||||
|
||||
instance (Show k, Show (f v)) => ShowTag (Const2 k v) f where
|
||||
showTaggedPrec (Const2 _) = showsPrec
|
||||
|
||||
instance Eq k => GEq (Const2 k v) where
|
||||
geq (Const2 a) (Const2 b) =
|
||||
if a == b
|
||||
@ -123,7 +119,7 @@ intMapWithFunctorToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=
|
||||
-- | Convert a 'DMap' to a regular 'Map' by forgetting the types associated with
|
||||
-- the keys, using a function to remove the wrapping 'Functor'
|
||||
weakenDMapWith :: (forall a. v a -> v') -> DMap k v -> Map (Some k) v'
|
||||
weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some.This k, f v)) . DMap.toAscList
|
||||
weakenDMapWith f = Map.fromDistinctAscList . map (\(k :=> v) -> (Some k, f v)) . DMap.toAscList
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- WrapArg
|
||||
@ -213,11 +209,6 @@ instance GShow (EitherTag l r) where
|
||||
LeftTag -> showString "LeftTag"
|
||||
RightTag -> showString "RightTag"
|
||||
|
||||
instance (Show l, Show r) => ShowTag (EitherTag l r) Identity where
|
||||
showTaggedPrec t n (Identity a) = case t of
|
||||
LeftTag -> showsPrec n a
|
||||
RightTag -> showsPrec n a
|
||||
|
||||
-- | Convert 'Either' to a 'DSum'. Inverse of 'dsumToEither'.
|
||||
eitherToDSum :: Either a b -> DSum (EitherTag a b) Identity
|
||||
eitherToDSum = \case
|
||||
|
@ -15,6 +15,7 @@ module Data.WeakBag
|
||||
, singleton
|
||||
, insert
|
||||
, traverse
|
||||
, traverse_
|
||||
, remove
|
||||
-- * Internal functions
|
||||
-- These will not always be available.
|
||||
@ -99,18 +100,22 @@ singleton a wbRef finalizer = {-# SCC "singleton" #-} do
|
||||
ticket <- insert a bag wbRef finalizer
|
||||
return (bag, ticket)
|
||||
|
||||
{-# INLINE traverse #-}
|
||||
{-# INLINE traverse_ #-}
|
||||
-- | Visit every node in the given list. If new nodes are appended during the
|
||||
-- traversal, they will not be visited. Every live node that was in the list
|
||||
-- when the traversal began will be visited exactly once; however, no guarantee
|
||||
-- is made about the order of the traversal.
|
||||
traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
|
||||
traverse (WeakBag _ children) f = {-# SCC "traverse" #-} do
|
||||
traverse_ :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
|
||||
traverse_ (WeakBag _ children) f = {-# SCC "traverse" #-} do
|
||||
cs <- liftIO $ readIORef children
|
||||
forM_ cs $ \c -> do
|
||||
ma <- liftIO $ deRefWeak c
|
||||
mapM_ f ma
|
||||
|
||||
{-# DEPRECATED traverse "Use 'traverse_' instead" #-}
|
||||
traverse :: MonadIO m => WeakBag a -> (a -> m ()) -> m ()
|
||||
traverse = traverse_
|
||||
|
||||
-- | Remove an item from the 'WeakBag'; does nothing if invoked multiple times
|
||||
-- on the same 'WeakBagTicket'.
|
||||
{-# INLINE remove #-}
|
||||
|
@ -16,6 +16,7 @@
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE Trustworthy #-}
|
||||
#ifdef USE_REFLEX_OPTIMIZER
|
||||
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
|
||||
#endif
|
||||
@ -35,16 +36,21 @@ module Reflex.Class
|
||||
, coerceBehavior
|
||||
, coerceEvent
|
||||
, coerceDynamic
|
||||
, coerceIncremental
|
||||
, MonadSample (..)
|
||||
, MonadHold (..)
|
||||
-- ** 'fan' related types
|
||||
, EventSelector (..)
|
||||
, EventSelectorG (..)
|
||||
, EventSelectorInt (..)
|
||||
-- * Convenience functions
|
||||
, constDyn
|
||||
, pushAlways
|
||||
-- ** Combining 'Event's
|
||||
, leftmost
|
||||
, merge
|
||||
, mergeIncremental
|
||||
, mergeIncrementalWithMove
|
||||
, mergeMap
|
||||
, mergeIntMap
|
||||
, mergeMapIncremental
|
||||
@ -59,6 +65,7 @@ module Reflex.Class
|
||||
, alignEventWithMaybe
|
||||
-- ** Breaking up 'Event's
|
||||
, splitE
|
||||
, fan
|
||||
, fanEither
|
||||
, fanThese
|
||||
, fanMap
|
||||
@ -83,6 +90,7 @@ module Reflex.Class
|
||||
, gate
|
||||
-- ** Combining 'Dynamic's
|
||||
, distributeDMapOverDynPure
|
||||
, distributeDMapOverDynPureG
|
||||
, distributeListOverDyn
|
||||
, distributeListOverDynWith
|
||||
, zipDyn
|
||||
@ -165,6 +173,17 @@ module Reflex.Class
|
||||
, slowHeadE
|
||||
) where
|
||||
|
||||
#ifdef MIN_VERSION_semialign
|
||||
import Prelude hiding (zip, zipWith)
|
||||
|
||||
#if MIN_VERSION_these(0,8,0)
|
||||
import Data.These.Combinators (justThese)
|
||||
#endif
|
||||
#if MIN_VERSION_semialign(1,1,0)
|
||||
import Data.Zip (Zip (..))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad.Identity
|
||||
import Control.Monad.Reader
|
||||
@ -192,8 +211,7 @@ import qualified Data.IntMap.Strict as IntMap
|
||||
import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Map (Map)
|
||||
import Data.Semigroup (Semigroup, sconcat, stimes, (<>))
|
||||
import Data.Some (Some)
|
||||
import qualified Data.Some as Some
|
||||
import Data.Some (Some(Some))
|
||||
import Data.String
|
||||
import Data.These
|
||||
import Data.Type.Coercion
|
||||
@ -255,11 +273,16 @@ class ( MonadHold t (PushM t)
|
||||
-- | Merge a collection of events; the resulting 'Event' will only occur if at
|
||||
-- least one input event is occurring, and will contain all of the input keys
|
||||
-- that are occurring simultaneously
|
||||
merge :: GCompare k => DMap k (Event t) -> Event t (DMap k Identity) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
|
||||
|
||||
--TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
|
||||
mergeG :: GCompare k => (forall a. q a -> Event t (v a))
|
||||
-> DMap k q -> Event t (DMap k v)
|
||||
|
||||
-- | Efficiently fan-out an event to many destinations. You should save the
|
||||
-- result in a @let@-binding, and then repeatedly 'select' on the result to
|
||||
-- result in a @let@-binding, and then repeatedly 'selectG' on the result to
|
||||
-- create child events
|
||||
fan :: GCompare k => Event t (DMap k Identity) -> EventSelector t k
|
||||
fanG :: GCompare k => Event t (DMap k v) -> EventSelectorG t k v
|
||||
|
||||
-- | Create an 'Event' that will occur whenever the currently-selected input
|
||||
-- 'Event' occurs
|
||||
switch :: Behavior t (Event t a) -> Event t a
|
||||
@ -277,9 +300,14 @@ class ( MonadHold t (PushM t)
|
||||
-- that value.
|
||||
unsafeBuildIncremental :: Patch p => PullM t (PatchTarget p) -> Event t p -> Incremental t p
|
||||
-- | Create a merge whose parents can change over time
|
||||
mergeIncremental :: GCompare k => Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
|
||||
mergeIncrementalG :: GCompare k
|
||||
=> (forall a. q a -> Event t (v a))
|
||||
-> Incremental t (PatchDMap k q)
|
||||
-> Event t (DMap k v)
|
||||
-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
|
||||
mergeIncrementalWithMove :: GCompare k => Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
|
||||
mergeIncrementalWithMoveG :: GCompare k
|
||||
=> (forall a. q a -> Event t (v a))
|
||||
-> Incremental t (PatchDMapWithMove k q) -> Event t (DMap k v)
|
||||
-- | Extract the 'Behavior' component of an 'Incremental'
|
||||
currentIncremental :: Patch p => Incremental t p -> Behavior t (PatchTarget p)
|
||||
-- | Extract the 'Event' component of an 'Incremental'
|
||||
@ -295,9 +323,25 @@ class ( MonadHold t (PushM t)
|
||||
-- | Construct a 'Coercion' for a 'Dynamic' given an 'Coercion' for its
|
||||
-- occurrence type
|
||||
dynamicCoercion :: Coercion a b -> Coercion (Dynamic t a) (Dynamic t b)
|
||||
-- | Construct a 'Coercion' for an 'Incremental' given 'Coercion's for its
|
||||
-- patch target and patch types.
|
||||
incrementalCoercion
|
||||
:: Coercion (PatchTarget a) (PatchTarget b) -> Coercion a b -> Coercion (Incremental t a) (Incremental t b)
|
||||
mergeIntIncremental :: Incremental t (PatchIntMap (Event t a)) -> Event t (IntMap a)
|
||||
fanInt :: Event t (IntMap a) -> EventSelectorInt t a
|
||||
|
||||
-- | Efficiently fan-out an event to many destinations. You should save the
|
||||
-- result in a @let@-binding, and then repeatedly 'select' on the result to
|
||||
-- create child events
|
||||
fan :: forall t k. (Reflex t, GCompare k)
|
||||
=> Event t (DMap k Identity) -> EventSelector t k
|
||||
--TODO: Can we help enforce the partial application discipline here? The combinator is worthless without it
|
||||
fan e = EventSelector (fixup (selectG (fanG e) :: k a -> Event t (Identity a)) :: forall a. k a -> Event t a)
|
||||
where
|
||||
fixup :: forall a. (k a -> Event t (Identity a)) -> k a -> Event t a
|
||||
fixup = case eventCoercion Coercion :: Coercion (Event t (Identity a)) (Event t a) of
|
||||
Coercion -> coerce
|
||||
|
||||
--TODO: Specialize this so that we can take advantage of knowing that there's no changing going on
|
||||
-- | Constructs a single 'Event' out of a map of events. The output event may fire with multiple
|
||||
-- keys simultaneously.
|
||||
@ -316,6 +360,12 @@ coerceEvent = coerceWith $ eventCoercion Coercion
|
||||
coerceDynamic :: (Reflex t, Coercible a b) => Dynamic t a -> Dynamic t b
|
||||
coerceDynamic = coerceWith $ dynamicCoercion Coercion
|
||||
|
||||
-- | Coerce an 'Incremental' between representationally-equivalent value types
|
||||
coerceIncremental
|
||||
:: (Reflex t, Coercible a b, Coercible (PatchTarget a) (PatchTarget b))
|
||||
=> Incremental t a -> Incremental t b
|
||||
coerceIncremental = coerceWith $ incrementalCoercion Coercion Coercion
|
||||
|
||||
-- | Construct a 'Dynamic' from a 'Behavior' and an 'Event'. The 'Behavior'
|
||||
-- __must__ change when and only when the 'Event' fires, such that the
|
||||
-- 'Behavior''s value is always equal to the most recent firing of the 'Event';
|
||||
@ -485,6 +535,17 @@ newtype EventSelector t k = EventSelector
|
||||
select :: forall a. k a -> Event t a
|
||||
}
|
||||
|
||||
newtype EventSelectorG t k v = EventSelectorG
|
||||
{ -- | Retrieve the 'Event' for the given key. The type of the 'Event' is
|
||||
-- determined by the type of the key, so this can be used to fan-out
|
||||
-- 'Event's whose sub-'Event's have different types.
|
||||
--
|
||||
-- Using 'EventSelector's and the 'fan' primitive is far more efficient than
|
||||
-- (but equivalent to) using 'mapMaybe' to select only the relevant
|
||||
-- occurrences of an 'Event'.
|
||||
selectG :: forall a. k a -> Event t (v a)
|
||||
}
|
||||
|
||||
-- | Efficiently select an 'Event' keyed on 'Int'. This is more efficient than manually
|
||||
-- filtering by key.
|
||||
newtype EventSelectorInt t a = EventSelectorInt { selectInt :: Int -> Event t a }
|
||||
@ -629,11 +690,7 @@ instance (Num a, Reflex t) => Num (Dynamic t a) where
|
||||
instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
|
||||
a <> b = pull $ liftM2 (<>) (sample a) (sample b)
|
||||
sconcat = pull . fmap sconcat . mapM sample
|
||||
#if MIN_VERSION_semigroups(0,17,0)
|
||||
stimes n = fmap $ stimes n
|
||||
#else
|
||||
times1p n = fmap $ times1p n
|
||||
#endif
|
||||
|
||||
-- | Alias for 'mapMaybe'
|
||||
fmapMaybe :: Filterable f => (a -> Maybe b) -> f a -> f b
|
||||
@ -660,9 +717,12 @@ filterRight = mapMaybe (either (const Nothing) Just)
|
||||
instance Reflex t => Alt (Event t) where
|
||||
ev1 <!> ev2 = leftmost [ev1, ev2]
|
||||
|
||||
-- | 'Event' intersection (convenient interface to 'coincidence').
|
||||
-- | 'Event' intersection. Only occurs when both events are co-incident.
|
||||
instance Reflex t => Apply (Event t) where
|
||||
evf <.> evx = coincidence (fmap (<$> evx) evf)
|
||||
evf <.> evx = mapMaybe f (align evf evx) where
|
||||
f (These g a) = Just (g a)
|
||||
f _ = Nothing
|
||||
|
||||
|
||||
-- | 'Event' intersection (convenient interface to 'coincidence').
|
||||
instance Reflex t => Bind (Event t) where
|
||||
@ -831,11 +891,7 @@ traceEventWith f = push $ \x -> trace (f x) $ return $ Just x
|
||||
instance (Semigroup a, Reflex t) => Semigroup (Event t a) where
|
||||
(<>) = alignWith (mergeThese (<>))
|
||||
sconcat = fmap sconcat . mergeList . toList
|
||||
#if MIN_VERSION_semigroups(0,17,0)
|
||||
stimes n = fmap $ stimes n
|
||||
#else
|
||||
times1p n = fmap $ times1p n
|
||||
#endif
|
||||
|
||||
instance (Semigroup a, Reflex t) => Monoid (Event t a) where
|
||||
mempty = never
|
||||
@ -1024,6 +1080,13 @@ instance Reflex t => Semialign (Event t) where
|
||||
#endif
|
||||
align = alignEventWithMaybe Just
|
||||
|
||||
#ifdef MIN_VERSION_semialign
|
||||
#if MIN_VERSION_semialign(1,1,0)
|
||||
instance Reflex t => Zip (Event t) where
|
||||
#endif
|
||||
zip x y = mapMaybe justThese $ align x y
|
||||
#endif
|
||||
|
||||
|
||||
-- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
|
||||
-- the 'Behavior' is true at the time of occurrence.
|
||||
@ -1064,11 +1127,7 @@ zipDynWith f da db =
|
||||
|
||||
instance (Reflex t, Semigroup a) => Semigroup (Dynamic t a) where
|
||||
(<>) = zipDynWith (<>)
|
||||
#if MIN_VERSION_semigroups(0,17,0)
|
||||
stimes n = fmap $ stimes n
|
||||
#else
|
||||
times1p n = fmap $ times1p n
|
||||
#endif
|
||||
|
||||
instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
|
||||
mconcat = distributeListOverDynWith mconcat
|
||||
@ -1079,12 +1138,21 @@ instance (Reflex t, Monoid a) => Monoid (Dynamic t a) where
|
||||
-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
|
||||
-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
|
||||
distributeDMapOverDynPure :: forall t k. (Reflex t, GCompare k) => DMap k (Dynamic t) -> Dynamic t (DMap k Identity)
|
||||
distributeDMapOverDynPure dm = case DMap.toList dm of
|
||||
distributeDMapOverDynPure = distributeDMapOverDynPureG coerceDynamic
|
||||
|
||||
-- | This function converts a 'DMap' whose elements are 'Dynamic's into a
|
||||
-- 'Dynamic' 'DMap'. Its implementation is more efficient than doing the same
|
||||
-- through the use of multiple uses of 'zipDynWith' or 'Applicative' operators.
|
||||
distributeDMapOverDynPureG
|
||||
:: forall t k q v. (Reflex t, GCompare k)
|
||||
=> (forall a. q a -> Dynamic t (v a))
|
||||
-> DMap k q -> Dynamic t (DMap k v)
|
||||
distributeDMapOverDynPureG nt dm = case DMap.toList dm of
|
||||
[] -> constDyn DMap.empty
|
||||
[k :=> v] -> fmap (DMap.singleton k . Identity) v
|
||||
[k :=> v] -> DMap.singleton k <$> nt v
|
||||
_ ->
|
||||
let getInitial = DMap.traverseWithKey (\_ -> fmap Identity . sample . current) dm
|
||||
edmPre = merge $ DMap.map updated dm
|
||||
let getInitial = DMap.traverseWithKey (\_ -> sample . current . nt) dm
|
||||
edmPre = mergeG getCompose $ DMap.map (Compose . updated . nt) dm
|
||||
result = unsafeBuildDynamic getInitial $ flip pushAlways edmPre $ \news -> do
|
||||
olds <- sample $ current result
|
||||
return $ DMap.unionWithKey (\_ _ new -> new) olds news
|
||||
@ -1154,9 +1222,9 @@ factorEvent
|
||||
-> Event t (DSum k v)
|
||||
-> m (Event t (v a), Event t (DSum k (Product v (Compose (Event t) v))))
|
||||
factorEvent k0 kv' = do
|
||||
key :: Behavior t (Some k) <- hold (Some.This k0) $ fmapCheap (\(k :=> _) -> Some.This k) kv'
|
||||
key :: Behavior t (Some k) <- hold (Some k0) $ fmapCheap (\(k :=> _) -> Some k) kv'
|
||||
let update = flip push kv' $ \(newKey :=> newVal) -> sample key >>= \case
|
||||
Some.This oldKey -> case newKey `geq` oldKey of
|
||||
Some oldKey -> case newKey `geq` oldKey of
|
||||
Just Refl -> return Nothing
|
||||
Nothing -> do
|
||||
newInner <- filterEventKey newKey kv'
|
||||
@ -1557,6 +1625,23 @@ fmapCheap f = pushCheap $ return . Just . f
|
||||
tagCheap :: Reflex t => Behavior t b -> Event t a -> Event t b
|
||||
tagCheap b = pushAlwaysCheap $ \_ -> sample b
|
||||
|
||||
-- | Merge a collection of events; the resulting 'Event' will only occur if at
|
||||
-- least one input event is occurring, and will contain all of the input keys
|
||||
-- that are occurring simultaneously
|
||||
merge :: (Reflex t, GCompare k) => DMap k (Event t) -> Event t (DMap k Identity)
|
||||
merge = mergeG coerceEvent
|
||||
{-# INLINE merge #-}
|
||||
|
||||
-- | Create a merge whose parents can change over time
|
||||
mergeIncremental :: (Reflex t, GCompare k)
|
||||
=> Incremental t (PatchDMap k (Event t)) -> Event t (DMap k Identity)
|
||||
mergeIncremental = mergeIncrementalG coerceEvent
|
||||
|
||||
-- | Experimental: Create a merge whose parents can change over time; changing the key of an Event is more efficient than with mergeIncremental
|
||||
mergeIncrementalWithMove :: (Reflex t, GCompare k)
|
||||
=> Incremental t (PatchDMapWithMove k (Event t)) -> Event t (DMap k Identity)
|
||||
mergeIncrementalWithMove = mergeIncrementalWithMoveG coerceEvent
|
||||
|
||||
-- | A "cheap" version of 'mergeWithCheap'. See the performance note on 'pushCheap'.
|
||||
{-# INLINE mergeWithCheap #-}
|
||||
mergeWithCheap :: Reflex t => (a -> a -> a) -> [Event t a] -> Event t a
|
||||
|
@ -27,6 +27,13 @@ module Reflex.Collection
|
||||
, simpleList
|
||||
) where
|
||||
|
||||
#ifdef MIN_VERSION_semialign
|
||||
import Prelude hiding (zip, zipWith)
|
||||
#if MIN_VERSION_semialign(1,1,0)
|
||||
import Data.Zip (Zip (..))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
import Control.Monad.Identity
|
||||
import Data.Align
|
||||
import Data.Functor.Misc
|
||||
|
@ -81,7 +81,7 @@ mkDynPure = QuasiQuoter
|
||||
}
|
||||
|
||||
mkDynExp :: String -> Q Exp
|
||||
mkDynExp s = case Hs.parseExpWithMode (Hs.defaultParseMode { Hs.extensions = [ Hs.EnableExtension Hs.TemplateHaskell ] }) s of
|
||||
mkDynExp s = case Hs.parseExpWithMode Hs.defaultParseMode { Hs.extensions = [ Hs.EnableExtension Hs.TemplateHaskell ] } s of
|
||||
Hs.ParseFailed (Hs.SrcLoc _ l c) err -> fail $ "mkDyn:" <> show l <> ":" <> show c <> ": " <> err
|
||||
Hs.ParseOk e -> qDynPure $ return $ everywhere (id `extT` reinstateUnqDyn) $ Hs.toExp $ everywhere (id `extT` antiE) e
|
||||
where TH.Name (TH.OccName occName) (TH.NameG _ _ (TH.ModName modName)) = 'unqMarker
|
||||
|
@ -52,7 +52,7 @@ import qualified Data.Map as Map
|
||||
import Data.Semigroup
|
||||
import Data.Some (Some)
|
||||
import Data.Tuple
|
||||
import Data.Type.Equality hiding (apply)
|
||||
import Data.Type.Equality
|
||||
|
||||
import Unsafe.Coerce
|
||||
|
||||
|
@ -20,7 +20,7 @@ import Reflex.NotReady.Class
|
||||
import Reflex.PostBuild.Class
|
||||
|
||||
-- | A 'Dynamic' "network": Takes a 'Dynamic' of network-creating actions and replaces the network whenever the 'Dynamic' updates.
|
||||
-- The returned Event of network results fires when the 'Dynamic' updates.
|
||||
-- The returned Event of network results fires at post-build time and when the 'Dynamic' updates.
|
||||
-- Note: Often, the type 'a' is an Event, in which case the return value is an Event-of-Events, where the outer 'Event' fires
|
||||
-- when switching networks. Such an 'Event' would typically be flattened (via 'switchPromptly').
|
||||
networkView :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)
|
||||
|
@ -19,9 +19,9 @@ import Reflex.Patch.Class
|
||||
import Reflex.Patch.MapWithMove (PatchMapWithMove (..))
|
||||
import qualified Reflex.Patch.MapWithMove as MapWithMove
|
||||
|
||||
import Data.Constraint.Extras
|
||||
import Data.Dependent.Map (DMap, DSum (..), GCompare (..))
|
||||
import qualified Data.Dependent.Map as DMap
|
||||
import Data.Dependent.Sum (EqTag (..))
|
||||
import Data.Functor.Constant
|
||||
import Data.Functor.Misc
|
||||
import Data.Functor.Product
|
||||
@ -30,8 +30,7 @@ import Data.GADT.Show (GShow, gshow)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Maybe
|
||||
import Data.Semigroup (Semigroup (..), (<>))
|
||||
import Data.Some (Some)
|
||||
import qualified Data.Some as Some
|
||||
import Data.Some (Some(Some))
|
||||
import Data.These
|
||||
|
||||
-- | Like 'PatchMapWithMove', but for 'DMap'. Each key carries a 'NodeInfo' which describes how it will be changed by the patch and connects move sources and
|
||||
@ -105,8 +104,8 @@ validationErrorsForPatchDMapWithMove m =
|
||||
unbalancedMove _ = Nothing
|
||||
|
||||
-- |Test whether two @'PatchDMapWithMove' k v@ contain the same patch operations.
|
||||
instance EqTag k (NodeInfo k v) => Eq (PatchDMapWithMove k v) where
|
||||
PatchDMapWithMove a == PatchDMapWithMove b = a == b
|
||||
instance (GEq k, Has' Eq k (NodeInfo k v)) => Eq (PatchDMapWithMove k v) where
|
||||
PatchDMapWithMove a == PatchDMapWithMove b = a == b
|
||||
|
||||
-- |Higher kinded 2-tuple, identical to @Data.Functor.Product@ from base ≥ 4.9
|
||||
data Pair1 f g a = Pair1 (f a) (g a)
|
||||
@ -311,8 +310,8 @@ weakenPatchDMapWithMoveWith f (PatchDMapWithMove p) = PatchMapWithMove $ weakenD
|
||||
{ MapWithMove._nodeInfo_from = case _nodeInfo_from ni of
|
||||
From_Insert v -> MapWithMove.From_Insert $ f v
|
||||
From_Delete -> MapWithMove.From_Delete
|
||||
From_Move k -> MapWithMove.From_Move $ Some.This k
|
||||
, MapWithMove._nodeInfo_to = Some.This <$> getComposeMaybe (_nodeInfo_to ni)
|
||||
From_Move k -> MapWithMove.From_Move $ Some k
|
||||
, MapWithMove._nodeInfo_to = Some <$> getComposeMaybe (_nodeInfo_to ni)
|
||||
}
|
||||
|
||||
-- |"Weaken" a @'PatchDMapWithMove' (Const2 k a) v@ to a @'PatchMapWithMove' k v'@. Weaken is in scare quotes because the 'Const2' has already disabled any
|
||||
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveFoldable #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
@ -33,14 +32,7 @@ instance Patch (PatchIntMap a) where
|
||||
instance Semigroup (PatchIntMap v) where
|
||||
PatchIntMap a <> PatchIntMap b = PatchIntMap $ a `mappend` b --TODO: Add a semigroup instance for Map
|
||||
-- PatchMap is idempotent, so stimes n is id for every n
|
||||
#if MIN_VERSION_semigroups(0,17,0)
|
||||
stimes = stimesIdempotentMonoid
|
||||
#else
|
||||
times1p n x = case compare n 0 of
|
||||
LT -> error "stimesIdempotentMonoid: negative multiplier"
|
||||
EQ -> mempty
|
||||
GT -> x
|
||||
#endif
|
||||
|
||||
-- | Map a function @Int -> a -> b@ over all @a@s in the given @'PatchIntMap' a@
|
||||
-- (that is, all inserts/updates), producing a @PatchIntMap b@.
|
||||
|
@ -1,4 +1,3 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
-- | 'Patch'es on 'Map' that consist only of insertions (including overwrites)
|
||||
@ -35,14 +34,7 @@ instance Ord k => Patch (PatchMap k v) where
|
||||
instance Ord k => Semigroup (PatchMap k v) where
|
||||
PatchMap a <> PatchMap b = PatchMap $ a `mappend` b --TODO: Add a semigroup instance for Map
|
||||
-- PatchMap is idempotent, so stimes n is id for every n
|
||||
#if MIN_VERSION_semigroups(0,17,0)
|
||||
stimes = stimesIdempotentMonoid
|
||||
#else
|
||||
times1p n x = case compare n 0 of
|
||||
LT -> error "stimesIdempotentMonoid: negative multiplier"
|
||||
EQ -> mempty
|
||||
GT -> x
|
||||
#endif
|
||||
|
||||
-- | The empty 'PatchMap' contains no insertions or deletions
|
||||
instance Ord k => Monoid (PatchMap k v) where
|
||||
|
@ -155,7 +155,7 @@ patchThatSortsMapWith cmp m = PatchMapWithMove $ Map.fromList $ catMaybes $ zipW
|
||||
Just (from, to)
|
||||
reverseMapping = Map.fromList $ catMaybes $ zipWith f unsorted sorted
|
||||
g (to, _) (from, _) = if to == from then Nothing else
|
||||
let Just movingTo = Map.lookup from reverseMapping
|
||||
let Just movingTo = Map.lookup to reverseMapping
|
||||
in Just (to, NodeInfo (From_Move from) $ Just movingTo)
|
||||
|
||||
-- | Create a 'PatchMapWithMove' that, if applied to the first 'Map' provided,
|
||||
|
@ -8,6 +8,9 @@
|
||||
{-# LANGUAGE StandaloneDeriving #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
-- |
|
||||
-- Module:
|
||||
-- Reflex.Profiled
|
||||
@ -16,7 +19,6 @@
|
||||
-- profiling/cost-center information.
|
||||
module Reflex.Profiled where
|
||||
|
||||
import Control.Lens hiding (children)
|
||||
import Control.Monad
|
||||
import Control.Monad.Exception
|
||||
import Control.Monad.Fix
|
||||
@ -33,6 +35,7 @@ import Data.Map (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Ord
|
||||
import Data.Profunctor.Unsafe ((#.))
|
||||
import qualified Data.Semigroup as S
|
||||
import Data.Type.Coercion
|
||||
import Foreign.Ptr
|
||||
@ -77,9 +80,9 @@ getCostCentreStack = go []
|
||||
go (cc : l) parent
|
||||
|
||||
toCostCentreTree :: Ptr CostCentreStack -> Int -> IO CostCentreTree
|
||||
toCostCentreTree ccs n = do
|
||||
ccList <- getCostCentreStack ccs
|
||||
return $ foldr (\cc child -> CostCentreTree 0 n $ Map.singleton cc child) (CostCentreTree n n mempty) ccList
|
||||
toCostCentreTree ccs n =
|
||||
foldr (\cc child -> CostCentreTree 0 n $ Map.singleton cc child) (CostCentreTree n n mempty)
|
||||
<$> getCostCentreStack ccs
|
||||
|
||||
getCostCentreTree :: IO CostCentreTree
|
||||
getCostCentreTree = do
|
||||
@ -133,27 +136,32 @@ instance Reflex t => Reflex (ProfiledTimeline t) where
|
||||
push f (Event_Profiled e) = coerce $ push (coerce f) $ profileEvent e -- Profile before rather than after; this way fanout won't count against us
|
||||
pushCheap f (Event_Profiled e) = coerce $ pushCheap (coerce f) $ profileEvent e
|
||||
pull = Behavior_Profiled . pull . coerce
|
||||
merge :: forall k. GCompare k => DMap k (Event (ProfiledTimeline t)) -> Event (ProfiledTimeline t) (DMap k Identity)
|
||||
merge = Event_Profiled . merge . (unsafeCoerce :: DMap k (Event (ProfiledTimeline t)) -> DMap k (Event t))
|
||||
fan (Event_Profiled e) = EventSelector $ coerce $ select (fan $ profileEvent e)
|
||||
fanG (Event_Profiled e) = EventSelectorG $ coerce $ selectG (fanG $ profileEvent e)
|
||||
mergeG :: forall (k :: z -> *) q v. GCompare k
|
||||
=> (forall a. q a -> Event (ProfiledTimeline t) (v a))
|
||||
-> DMap k q -> Event (ProfiledTimeline t) (DMap k v)
|
||||
mergeG nt = Event_Profiled #. mergeG (coerce nt)
|
||||
switch (Behavior_Profiled b) = coerce $ profileEvent $ switch (coerceBehavior b)
|
||||
coincidence (Event_Profiled e) = coerce $ profileEvent $ coincidence (coerceEvent e)
|
||||
current (Dynamic_Profiled d) = coerce $ current d
|
||||
updated (Dynamic_Profiled d) = coerce $ profileEvent $ updated d
|
||||
unsafeBuildDynamic (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildDynamic a0 a'
|
||||
unsafeBuildIncremental (ProfiledM a0) (Event_Profiled a') = coerce $ unsafeBuildIncremental a0 a'
|
||||
mergeIncremental = Event_Profiled . mergeIncremental . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchDMap k (Event (ProfiledTimeline t))) -> Incremental t (PatchDMap k (Event t)))
|
||||
mergeIncrementalWithMove = Event_Profiled . mergeIncrementalWithMove . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchDMapWithMove k (Event (ProfiledTimeline t))) -> Incremental t (PatchDMapWithMove k (Event t)))
|
||||
mergeIncrementalG nt = (Event_Profiled . coerce) #. mergeIncrementalG nt
|
||||
mergeIncrementalWithMoveG nt = (Event_Profiled . coerce) #. mergeIncrementalWithMoveG nt
|
||||
currentIncremental (Incremental_Profiled i) = coerce $ currentIncremental i
|
||||
updatedIncremental (Incremental_Profiled i) = coerce $ profileEvent $ updatedIncremental i
|
||||
incrementalToDynamic (Incremental_Profiled i) = coerce $ incrementalToDynamic i
|
||||
behaviorCoercion (c :: Coercion a b) = case behaviorCoercion c :: Coercion (Behavior t a) (Behavior t b) of
|
||||
Coercion -> unsafeCoerce (Coercion :: Coercion (Behavior (ProfiledTimeline t) a) (Behavior (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce
|
||||
eventCoercion (c :: Coercion a b) = case eventCoercion c :: Coercion (Event t a) (Event t b) of
|
||||
Coercion -> unsafeCoerce (Coercion :: Coercion (Event (ProfiledTimeline t) a) (Event (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce
|
||||
dynamicCoercion (c :: Coercion a b) = case dynamicCoercion c :: Coercion (Dynamic t a) (Dynamic t b) of
|
||||
Coercion -> unsafeCoerce (Coercion :: Coercion (Dynamic (ProfiledTimeline t) a) (Dynamic (ProfiledTimeline t) a)) --TODO: Figure out how to make this typecheck without the unsafeCoerce
|
||||
mergeIntIncremental = Event_Profiled . mergeIntIncremental . (unsafeCoerce :: Incremental (ProfiledTimeline t) (PatchIntMap (Event (ProfiledTimeline t) a)) -> Incremental t (PatchIntMap (Event t a)))
|
||||
behaviorCoercion c =
|
||||
Coercion `trans` behaviorCoercion @t c `trans` Coercion
|
||||
eventCoercion c =
|
||||
Coercion `trans` eventCoercion @t c `trans` Coercion
|
||||
dynamicCoercion c =
|
||||
Coercion `trans` dynamicCoercion @t c `trans` Coercion
|
||||
incrementalCoercion c d =
|
||||
Coercion `trans` incrementalCoercion @t c d `trans` Coercion
|
||||
mergeIntIncremental = Event_Profiled . mergeIntIncremental .
|
||||
coerceWith (Coercion `trans` incrementalCoercion Coercion Coercion `trans` Coercion)
|
||||
fanInt (Event_Profiled e) = coerce $ fanInt $ profileEvent e
|
||||
|
||||
deriving instance Functor (Dynamic t) => Functor (Dynamic (ProfiledTimeline t))
|
||||
|
@ -5,6 +5,9 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
|
||||
#ifdef USE_REFLEX_OPTIMIZER
|
||||
{-# OPTIONS_GHC -fplugin=Reflex.Optimizer #-}
|
||||
#endif
|
||||
@ -28,14 +31,9 @@ module Reflex.Pure
|
||||
, Incremental (..)
|
||||
) where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
|
||||
import Control.Monad
|
||||
import Data.Dependent.Map (DMap, GCompare)
|
||||
import qualified Data.Dependent.Map as DMap
|
||||
import Data.Functor.Identity
|
||||
import Data.IntMap (IntMap)
|
||||
import qualified Data.IntMap as IntMap
|
||||
import Data.Maybe
|
||||
@ -43,10 +41,11 @@ import Data.MemoTrie
|
||||
import Data.Monoid
|
||||
import Data.Type.Coercion
|
||||
import Reflex.Class
|
||||
import Data.Kind (Type)
|
||||
|
||||
-- | A completely pure-functional 'Reflex' timeline, identifying moments in time
|
||||
-- with the type @/t/@.
|
||||
data Pure t
|
||||
data Pure (t :: Type)
|
||||
|
||||
-- | The 'Enum' instance of @/t/@ must be dense: for all @/x :: t/@, there must not exist
|
||||
-- any @/y :: t/@ such that @/'pred' x < y < x/@. The 'HasTrie' instance will be used
|
||||
@ -79,17 +78,19 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
|
||||
-- [UNUSED_CONSTRAINT]: The following type signature for merge will produce a
|
||||
-- warning because the GCompare instance is not used; however, removing the
|
||||
-- GCompare instance produces a different warning, due to that constraint
|
||||
-- being present in the original class definition
|
||||
-- being present in the original class definition.
|
||||
|
||||
--merge :: GCompare k => DMap k (Event (Pure t)) -> Event (Pure t) (DMap k Identity)
|
||||
merge events = Event $ memo $ \t ->
|
||||
let currentOccurrences = DMap.mapMaybeWithKey (\_ (Event a) -> Identity <$> a t) events
|
||||
--mergeG :: GCompare k => (forall a. q a -> Event (Pure t) (v a))
|
||||
-- -> DMap k q -> Event (Pure t) (DMap k v)
|
||||
mergeG nt events = Event $ memo $ \t ->
|
||||
let currentOccurrences = DMap.mapMaybeWithKey (\_ q -> case nt q of Event a -> a t) events
|
||||
in if DMap.null currentOccurrences
|
||||
then Nothing
|
||||
else Just currentOccurrences
|
||||
|
||||
fan :: GCompare k => Event (Pure t) (DMap k Identity) -> EventSelector (Pure t) k
|
||||
fan e = EventSelector $ \k -> Event $ \t -> unEvent e t >>= fmap runIdentity . DMap.lookup k
|
||||
-- The instance signature doeesn't compile, leave commented for documentation
|
||||
-- fanG :: GCompare k => Event (Pure t) (DMap k v) -> EventSelectorG (Pure t) k v
|
||||
fanG e = EventSelectorG $ \k -> Event $ \t -> unEvent e t >>= DMap.lookup k
|
||||
|
||||
switch :: Behavior (Pure t) (Event (Pure t) a) -> Event (Pure t) a
|
||||
switch b = Event $ memo $ \t -> unEvent (unBehavior b t) t
|
||||
@ -112,8 +113,8 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
|
||||
--a) -> Incremental (Pure t) p a
|
||||
unsafeBuildIncremental readV0 p = Incremental $ \t -> (readV0 t, unEvent p t)
|
||||
|
||||
mergeIncremental = mergeIncrementalImpl
|
||||
mergeIncrementalWithMove = mergeIncrementalImpl
|
||||
mergeIncrementalG = mergeIncrementalImpl
|
||||
mergeIncrementalWithMoveG = mergeIncrementalImpl
|
||||
|
||||
currentIncremental i = Behavior $ \t -> fst $ unIncremental i t
|
||||
|
||||
@ -128,14 +129,17 @@ instance (Enum t, HasTrie t, Ord t) => Reflex (Pure t) where
|
||||
behaviorCoercion Coercion = Coercion
|
||||
eventCoercion Coercion = Coercion
|
||||
dynamicCoercion Coercion = Coercion
|
||||
incrementalCoercion Coercion Coercion = Coercion
|
||||
|
||||
fanInt e = EventSelectorInt $ \k -> Event $ \t -> unEvent e t >>= IntMap.lookup k
|
||||
|
||||
mergeIntIncremental = mergeIntIncrementalImpl
|
||||
|
||||
mergeIncrementalImpl :: (PatchTarget p ~ DMap k (Event (Pure t)), GCompare k) => Incremental (Pure t) p -> Event (Pure t) (DMap k Identity)
|
||||
mergeIncrementalImpl i = Event $ \t ->
|
||||
let results = DMap.mapMaybeWithKey (\_ (Event e) -> Identity <$> e t) $ fst $ unIncremental i t
|
||||
mergeIncrementalImpl :: (PatchTarget p ~ DMap k q, GCompare k)
|
||||
=> (forall a. q a -> Event (Pure t) (v a))
|
||||
-> Incremental (Pure t) p -> Event (Pure t) (DMap k v)
|
||||
mergeIncrementalImpl nt i = Event $ \t ->
|
||||
let results = DMap.mapMaybeWithKey (\_ q -> case nt q of Event e -> e t) $ fst $ unIncremental i t
|
||||
in if DMap.null results
|
||||
then Nothing
|
||||
else Just results
|
||||
|
@ -37,8 +37,7 @@ import Data.Map (Map)
|
||||
import qualified Data.Map as Map
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.Semigroup as S
|
||||
import Data.Some (Some)
|
||||
import qualified Data.Some as Some
|
||||
import Data.Some (Some(Some))
|
||||
import Data.These
|
||||
|
||||
import Reflex.Class
|
||||
@ -144,10 +143,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t
|
||||
liftedResult' = fforCheap result' $ \(PatchDMap p) -> PatchDMap $
|
||||
mapKeyValuePairsMonotonic (\(k :=> ComposeMaybe mr) -> k :=> ComposeMaybe (fmap (getQueryTLoweredResultValue . getCompose) mr)) p
|
||||
liftedBs0 :: Map (Some k) [Behavior t q]
|
||||
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
|
||||
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
|
||||
liftedBs' :: Event t (PatchMap (Some k) [Behavior t q])
|
||||
liftedBs' = fforCheap result' $ \(PatchDMap p) -> PatchMap $
|
||||
Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some.This k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p
|
||||
Map.fromDistinctAscList $ (\(k :=> ComposeMaybe mr) -> (Some k, fmap (getQueryTLoweredResultWritten . getCompose) mr)) <$> DMap.toList p
|
||||
sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
|
||||
sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty
|
||||
accumBehaviors :: forall m'. MonadHold t m'
|
||||
@ -188,10 +187,10 @@ instance (Reflex t, MonadFix m, Group q, Additive q, Query q, Eq q, MonadHold t
|
||||
let liftedResult0 = mapKeyValuePairsMonotonic (\(k :=> Compose r) -> k :=> getQueryTLoweredResultValue r) result0
|
||||
liftedResult' = fforCheap result' $ mapPatchDMapWithMove (getQueryTLoweredResultValue . getCompose)
|
||||
liftedBs0 :: Map (Some k) [Behavior t q]
|
||||
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some.This k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
|
||||
liftedBs0 = Map.fromDistinctAscList $ (\(k :=> Compose r) -> (Some k, getQueryTLoweredResultWritten r)) <$> DMap.toList result0
|
||||
liftedBs' :: Event t (PatchMapWithMove (Some k) [Behavior t q])
|
||||
liftedBs' = fforCheap result' $ weakenPatchDMapWithMoveWith (getQueryTLoweredResultWritten . getCompose) {- \(PatchDMap p) -> PatchMapWithMove $
|
||||
Map.fromDistinctAscList $ (\(k :=> mr) -> (Some.This k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}
|
||||
Map.fromDistinctAscList $ (\(k :=> mr) -> (Some k, fmap (fmap (getQueryTLoweredResultWritten . getCompose)) mr)) <$> DMap.toList p -}
|
||||
sampleBs :: forall m'. MonadSample t m' => [Behavior t q] -> m' q
|
||||
sampleBs = foldlM (\b a -> (b <>) <$> sample a) mempty
|
||||
accumBehaviors' :: forall m'. MonadHold t m'
|
||||
|
@ -66,8 +66,7 @@ import qualified Data.Map as Map
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Proxy
|
||||
import qualified Data.Semigroup as S
|
||||
import Data.Some (Some)
|
||||
import qualified Data.Some as Some
|
||||
import Data.Some (Some(Some))
|
||||
import Data.Type.Equality
|
||||
import Data.Unique.Tag
|
||||
|
||||
@ -441,7 +440,7 @@ traverseDMapWithKeyWithAdjustRequesterTWith base mapPatch weakenPatchWith patchN
|
||||
pack = Entry
|
||||
f' :: forall a. k a -> Compose ((,) Int) v a -> m (Compose ((,) (Event t (IntMap (RequesterData request)))) v' a)
|
||||
f' k (Compose (n, v)) = do
|
||||
(result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some.This k))
|
||||
(result, myRequests) <- runRequesterT (f k v) $ mapMaybeCheap (IntMap.lookup n) $ select responses (Const2 (Some k))
|
||||
return $ Compose (fmapCheap (IntMap.singleton n) myRequests, result)
|
||||
ndm' <- numberOccurrencesFrom 1 dm'
|
||||
(children0, children') <- base f' (DMap.map (\v -> Compose (0, v)) dm0) $ fmap (\(n, dm) -> mapPatch (\v -> Compose (n, v)) dm) ndm'
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -34,7 +34,7 @@ workflow w0 = do
|
||||
rec eResult <- networkHold (unWorkflow w0) $ fmap unWorkflow $ switch $ snd <$> current eResult
|
||||
return $ fmap fst eResult
|
||||
|
||||
-- | Similar to 'workflow', but outputs an 'Event' that fires whenever the current 'Workflow' is replaced by the next 'Workflow'.
|
||||
-- | Similar to 'workflow', but outputs an 'Event' that fires at post-build time and whenever the current 'Workflow' is replaced by the next 'Workflow'.
|
||||
workflowView :: forall t m a. (Reflex t, NotReady t m, Adjustable t m, MonadFix m, MonadHold t m, PostBuild t m) => Workflow t m a -> m (Event t a)
|
||||
workflowView w0 = do
|
||||
rec eResult <- networkView . fmap unWorkflow =<< holdDyn w0 eReplace
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
@ -13,6 +14,10 @@ import Data.Functor.Misc
|
||||
import qualified Data.Map as M
|
||||
import Data.These
|
||||
|
||||
#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
|
||||
import Data.These.Lens
|
||||
#endif
|
||||
|
||||
import Reflex
|
||||
import Reflex.EventWriter.Base
|
||||
import Test.Run
|
||||
@ -48,16 +53,13 @@ unwrapApp x appIn = do
|
||||
return e
|
||||
|
||||
testOrdering :: (Reflex t, Monad m) => Event t () -> EventWriterT t [Int] m ()
|
||||
testOrdering pulse = do
|
||||
forM_ [10,9..1] $ \i -> tellEvent ([i] <$ pulse)
|
||||
return ()
|
||||
testOrdering pulse = forM_ [10,9..1] $ \i -> tellEvent ([i] <$ pulse)
|
||||
|
||||
testSimultaneous :: (Reflex t, Adjustable t m, MonadHold t m) => Event t (These () ()) -> EventWriterT t [Int] m ()
|
||||
testSimultaneous pulse = do
|
||||
let e0 = fmapMaybe (^? here) pulse
|
||||
e1 = fmapMaybe (^? there) pulse
|
||||
forM_ [1,3..9] $ \i -> runWithReplace (tellEvent ([i] <$ e0)) $ ffor e1 $ \_ -> tellEvent ([i+1] <$ e0)
|
||||
return ()
|
||||
|
||||
-- | Test that a widget telling and event which fires at the same time it has been replaced
|
||||
-- doesn't count along with the new widget.
|
||||
|
@ -27,6 +27,7 @@ import qualified Reflex.Spider.Internal as S
|
||||
|
||||
import System.Exit
|
||||
import System.Mem
|
||||
import Data.Coerce
|
||||
|
||||
main :: IO ()
|
||||
main = do
|
||||
@ -46,7 +47,7 @@ hostPerf ref = S.runSpiderHost $ do
|
||||
eventToPerform <- Host.runHostFrame $ do
|
||||
(reqMap :: S.Event S.Global (DMap (Const2 Int (DMap Tell (S.SpiderHostFrame S.Global))) Identity))
|
||||
<- S.SpiderHostFrame
|
||||
$ fmap ( S.merge
|
||||
$ fmap ( S.mergeG coerce
|
||||
. S.dynamicHold)
|
||||
$ S.hold DMap.empty
|
||||
-- Construct a new heap object for the subscriber, invalidating any weak references to the subscriber if they are not retained
|
||||
@ -55,8 +56,8 @@ hostPerf ref = S.runSpiderHost $ do
|
||||
{ S.subscriberPropagate = S.subscriberPropagate sub
|
||||
}
|
||||
return (s, o))
|
||||
$ runIdentity <$> S.select
|
||||
(S.fan $ S.pushCheap (return . Just . mapKeyValuePairsMonotonic (\(t :=> e) -> WrapArg t :=> Identity e)) response)
|
||||
$ runIdentity . runIdentity <$> S.selectG
|
||||
(S.fanG $ S.pushCheap (return . Just . mapKeyValuePairsMonotonic (\(t :=> e) -> WrapArg t :=> Identity e)) response)
|
||||
(WrapArg Request)
|
||||
return $ alignWith (mergeThese (<>))
|
||||
(flip S.pushCheap eadd $ \_ -> return $ Just $ DMap.singleton Request $ do
|
||||
|
@ -19,6 +19,10 @@ import Data.Map.Monoidal (MonoidalMap)
|
||||
import Data.Semigroup
|
||||
import Data.These
|
||||
|
||||
#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
|
||||
import Data.These.Lens
|
||||
#endif
|
||||
|
||||
import Reflex
|
||||
import Reflex.Patch.MapWithMove
|
||||
import Test.Run
|
||||
|
@ -130,6 +130,16 @@ mapDynChain = iterM (return . fmap (+1))
|
||||
joinDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
|
||||
joinDynChain = iterM (\d -> return $ join $ fmap (const d) d)
|
||||
|
||||
holdDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
|
||||
holdDynChain = iterM (\d -> sample (current d) >>= flip holdDyn (updated d))
|
||||
|
||||
buildDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
|
||||
buildDynChain = iterM (\d -> do
|
||||
let b = fmap (+1) (current d)
|
||||
e = fmap (*2) (updated d)
|
||||
buildDynamic (sample b) e)
|
||||
|
||||
|
||||
combineDynChain :: (Reflex t, MonadHold t m) => Word -> Dynamic t Word -> m (Dynamic t Word)
|
||||
combineDynChain = iterM (\d -> return $ zipDynWith (+) d d)
|
||||
|
||||
@ -308,6 +318,8 @@ dynamics :: Word -> [(String, TestCase)]
|
||||
dynamics n =
|
||||
[ testE "mapDynChain" $ fmap updated $ mapDynChain n =<< d
|
||||
, testE "joinDynChain" $ fmap updated $ joinDynChain n =<< d
|
||||
, testE "holdDynChain" $ fmap updated $ holdDynChain n =<< d
|
||||
, testE "buildDynChain" $ fmap updated $ buildDynChain n =<< d
|
||||
, testE "combineDynChain" $ fmap updated $ combineDynChain n =<< d
|
||||
, testE "dense mergeTree" $ fmap (updated . mergeTreeDyn 8) dense
|
||||
, testE "sparse mergeTree" $ fmap (updated . mergeTreeDyn 8) sparse
|
||||
|
@ -218,6 +218,11 @@ testCases =
|
||||
bb <- hold b $ pushAlways (const $ hold "asdf" eo) eo
|
||||
let b' = pull $ sample =<< sample bb
|
||||
return (b', e)
|
||||
, (,) "foldDynWhileFiring" $ TestCase (Map.singleton 0 "zxc", Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(_, e) -> do
|
||||
d <- foldDyn (:) [] $
|
||||
pushAlways (\a -> foldDyn (:) [a] e) e
|
||||
let b = current (join (fmap distributeListOverDynPure d))
|
||||
return (b, e)
|
||||
, (,) "joinDyn" $ TestCase (Map.singleton 0 (0 :: Int), Map.fromList [(1, "qwer"), (2, "lkj")]) $ \(b, e) -> do
|
||||
bb <- hold "b" e
|
||||
bd <- hold never . fmap (const e) =<< headE e
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE BangPatterns #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE GADTs #-}
|
||||
@ -15,6 +16,10 @@ import Data.Functor.Misc
|
||||
import qualified Data.Map as M
|
||||
import Data.These
|
||||
|
||||
#if defined(MIN_VERSION_these_lens) || (MIN_VERSION_these(0,8,0) && !MIN_VERSION_these(0,9,0))
|
||||
import Data.These.Lens
|
||||
#endif
|
||||
|
||||
import Reflex
|
||||
import Reflex.Requester.Base
|
||||
import Reflex.Requester.Class
|
||||
|
@ -22,6 +22,7 @@ main = do
|
||||
, "--ignore=Use unless"
|
||||
, "--ignore=Reduce duplication"
|
||||
, "--cpp-define=USE_TEMPLATE_HASKELL"
|
||||
, "--ignore=Use tuple-section"
|
||||
]
|
||||
recurseInto = and <$> sequence
|
||||
[ fileType ==? Directory
|
||||
|
Loading…
Reference in New Issue
Block a user