reactive-banana-1.2.1.0/0000755000000000000000000000000013415425603013062 5ustar0000000000000000reactive-banana-1.2.1.0/Setup.hs0000644000000000000000000000005613415425603014517 0ustar0000000000000000import Distribution.Simple main = defaultMain reactive-banana-1.2.1.0/CHANGELOG.md0000644000000000000000000002106213415425603014674 0ustar0000000000000000Changelog for the `reactive-banana** package ------------------------------------------- **version 1.2.1.0** * Add `Num`, `Floating`, `Fractional`, and `IsString` instances for `Behavior`. [#34][] * Support `containers-0.6`. [#191][] [#34]: https://github.com/HeinrichApfelmus/reactive-banana/pull/34 [#191]: https://github.com/HeinrichApfelmus/reactive-banana/pull/191 **version 1.2.0.0** * Make `MonadFix` superclass of `MonadMoment`. [#128][] * Add `Semigroup` and `Monoid` instances for `Event`. [#104][] * Semigroup compatibility with GHC 8.4.1 [#168][] * Increased upper-bound on `pqueue`. [#128]: https://github.com/HeinrichApfelmus/reactive-banana/pull/128 [#104]: https://github.com/HeinrichApfelmus/reactive-banana/issues/104 [#168]: https://github.com/HeinrichApfelmus/reactive-banana/pull/168 **version 1.1.0.1** * Adapt library to work with GHC-8.0.1. **version 1.1.0.0** * Fix bug: Types of `switchB` and `switchE` need to be in the `Moment` monad. * Clean up and simplify model implementation in the `Reactive.Banana.Model` module. * Update type signatures of the `interpret*` functions to make it easier to try FRP functions in the REPL. * Remove `showNetwork` function. **version 1.0.0.1** * Improve documentation. * Add prose section on recursion. * Improve explanation for the `changes` function. * Bump `transfomers` dependency. * Remove defunct `UseExtensions` flag from cabal file. **version 1.0.0.0** The API has been redesigned significantly in this version! * Remove phantom type parameter `t` from `Event`, `Behavior` and `Moment` types. * Change accumulation functions (`accumB`, `accumE`, `stepper`) to have a monadic result type. * Merge module `Reactive.Banana.Switch` into module `Reactive.Banana.Combinators`. * Simplify types of the switching functions (`switchE`, `switchB`, `observeB`, `execute`). * Remove functions `trimE` and `trimB`. * Remove types `AnyMoment` and `Identity`. * Remove `Frameworks` class constraint, use `MomentIO` type instead. * Add class `MonadMoment` for both polymorphism over the `Moment` and `MomentIO` types. * Change type `Event` to only allow a single event per moment in time. * Remove function `union`. Use `unionWith` instead. * Change function `unions` to only merge events of type `Event (a -> a)`. * Remove module `Reactive.Banana.Experimental.Calm`. * Change the model implementation in the module `Reactive.Banana.Model` to the new API as well. Other changes: * Add `mapEventIO` utility function to build an Event that contains the result of an IO computation. * Add `newBehavior` utility function to build a Behavior that can be updated with a `Handler`. * Add illustrations to the API documentation. **version 0.9.0.0** * Implement garbage collection for dynamically switched events. * Fix issue [#79][] where recursive declarations would sometimes result in dropped events. * Limit value recursion in the `Moment` monad slightly. * Change `initial` and `valueB` to behave subtly different when it comes to value recursion in the `Moment` monad. * Add `Functor`, `Applicative` and `Monad` instances for the `FrameworksMoment` type. * Depend on the [pqueue][] package instead of the [psqueues][] package again, as the former has been updated to work with the current version of GHC. [#79]: https://github.com/HeinrichApfelmus/reactive-banana/issues/79 **version 0.8.1.2** * Depend on the [psqueues][] package instead of the [pqueue][] package for the priority queue. [psqueues]: https://hackage.haskell.org/package/psqueues [pqueue]: http://hackage.haskell.org/package/pqueue **version 0.8.1.1** * Links to the Haskell wiki now point to the `http://wiki.haskell.org` subdomain. **version 0.8.1.0** * Module `Reactive.Banana.Switch` now adheres to the "Functor Applicative Monad Proposal" proposal][amp-proposal]. [amp-proposal]: https://wiki.haskell.org/Functor-Applicative-Monad_Proposal **version 0.8.0.4** * Just a re-upload. The previous archive was broken. **version 0.8.0.3** * Export the `Future` type. * Restrict `containers` dependency to lower bound 0.5. **version 0.8.0.2** * Fix compilation issue with hiding `empty` from the module `Reactive.Banana.Prim.Order`. **version 0.8.0.1** * New examples `Counter.hs` and `Octave.hs`. * Bump `transfomers` dependency. **version 0.8.0.0** * A new module `Reactive.Banana.Prim` exports primitive combinators that you can use to implement your own FRP library with a different API. * The push-driven implementation in `Reactive.Banana.Prim` now has the performance characteristics of an actual push-driven implementation. Some work has gone into optimizing constant factors as well. However there is still no garbage collection for dynamically created events and behaviors. * The `accumE` and `accumB` combinators evaluate their state to WHNF to avoid a space leak. (Fixes issue #52). On the other hand, `Behavior` values are evaluated on demanded, i.e. only when required by the apply combinator `<@>` or similar. * Recursion between events and behaviors should now work as advertised. (Fixed issue #56). * The deprecated `liftIONow` function has been removed. * The type of the `changes` function now indicates that the new Behavior value is only available in the context of `reactimate`. A variant `reactimate'` makes this explicit. * The module `Control.Event.Handler` now exports the `AddHandler` type, which is now a `newtype`. The module `Reactive.Banana.Frameworks.AddHandler` has been removed. **version 0.7.1.0** * Deprecate the `liftIONow` function in favor of `liftIO`. **version 0.7.0.0** * *Dynamic event switching*. Combinators are now available in the module `Reactive.Banana.Switch`. * Rename `NetworkDescription` to `Moment`, add class constraint `Frameworks t`. * No longer compiles with the JavaScript backend of the Utrecht Haskell compiler. * Change the `changes` combinator to be less useful. **version 0.6.0.0** * Can now be compiled with the JavaScript backend of the Utrecht Haskell compiler. * The push-driven implementations needs the `UseExtensions` flag to work. This flag is enabled by default. * Minor module reorganization. **version 0.5.0.0** -- [announcement](http://apfelmus.nfshost.com/blog/2012/03/25-frp-banana-0-5.html) This update includes numerous changes, in particular a complete overhaul of the internal implementation. Here a partial list. * Add `collect`, `spill` and `unionWith` combinators to deal with simultaneous events. * Remove general `Monoid` instance for `Event` to simplify reasoning about simultaneous events. * Add `initial` and `changes` combinators that allow you to observe updates to `Behavior`. Remove the `Reactive.Banana.Incremental` module. * Rename most modules, * Change type signatures: The main types `Event`, `Behavior` and `NetworkDescription` now carry an additional phantom type. **version 0.4.3.1** * Model implementation of `accumE` now has the intended semantics. **version 0.4.3.0** * Change semantics: `IO` actions from inside `reactimate` may now interleave as dictated by your event-based framework (issue #15). * Fix bug: compiling a network twice no longer fails due to lingering global state (issue #16). * Change type: remove `Typeable` constraint from `interpret` and `interpretAsHandler`. * Misc: Remove the `BlackBoard` application from the repository. **version 0.4.2.0** * Change type: remove `Typeable` constraint from `fromAddHandler`. * Misc: the `Vault` data type gets its own package. * Misc: `reactive-banana-wx` now compiles properly with cabal. * Add some more examples to the `reactive-banana-wx` package. **version 0.4.1.0** * Add `<@>` operator for more convenience when using `apply`. * Add support for value recursion to the `NetworkDescription` monad. * Add many examples to `reactive-banana-wx`. **version 0.4.0.0** -- [announcement](http://apfelmus.nfshost.com/blog/2011/07/07-frp-banana-0-4.html) * Add function `fromPoll` to obtain behaviors from mutable data. * Change name: `run` is now called `actuate`. * Add derived data type `Discrete`. * Add function `interpretAsHandler`. **version 0.3.0.0** -- [announcement](http://apfelmus.nfshost.com/blog/2011/06/22-frp-banana-0-3.html) * change: event networks are now first-class values, you can `pause` or `run` them. * change type: `AddHandler` now expects a way to unregister event handlers. * add example `RunPause.hs` **version 0.2.0.0** -- [announcement](http://apfelmus.nfshost.com/blog/2011/06/22-frp-banana-0-2.html) * change: now implements proper semantics as pioneered by Conal Elliott * model implementation for semantics * push-driven implementation for efficiency * add example `SlotMachine.hs` **version 0.1.0.0** * initial release reactive-banana-1.2.1.0/LICENSE0000644000000000000000000000300013415425603014060 0ustar0000000000000000Copyright (c)2011-2015, Heinrich Apfelmus All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Heinrich Apfelmus nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. reactive-banana-1.2.1.0/reactive-banana.cabal0000644000000000000000000000760713415425603017100 0ustar0000000000000000Name: reactive-banana Version: 1.2.1.0 Synopsis: Library for functional reactive programming (FRP). Description: Reactive-banana is a library for Functional Reactive Programming (FRP). . FRP offers an elegant and concise way to express interactive programs such as graphical user interfaces, animations, computer music or robot controllers. It promises to avoid the spaghetti code that is all too common in traditional approaches to GUI programming. . See the project homepage for more detailed documentation and examples. . /Stability forecast./ This is a stable library, though minor API changes are still likely. It features an efficient, push-driven implementation and has seen some optimization work. . /API guide./ Start with the "Reactive.Banana" module. Homepage: http://wiki.haskell.org/Reactive-banana License: BSD3 License-file: LICENSE Author: Heinrich Apfelmus Maintainer: Heinrich Apfelmus Category: FRP Cabal-version: 1.18 Build-type: Simple Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1, GHC == 8.0.1, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1 extra-source-files: CHANGELOG.md, doc/examples/*.hs, src/Reactive/Banana/Test.hs, src/Reactive/Banana/Test/Plumbing.hs extra-doc-files: doc/*.png Source-repository head type: git location: git://github.com/HeinrichApfelmus/reactive-banana.git subdir: reactive-banana/ Library default-language: Haskell98 hs-source-dirs: src build-depends: base >= 4.2 && < 5, semigroups >= 0.13 && < 0.19, containers >= 0.5 && < 0.7, transformers >= 0.2 && < 0.6, vault == 0.3.*, unordered-containers >= 0.2.1.0 && < 0.3, hashable >= 1.1 && < 1.3, pqueue >= 1.0 && < 1.5 exposed-modules: Control.Event.Handler, Reactive.Banana, Reactive.Banana.Combinators, Reactive.Banana.Frameworks, Reactive.Banana.Model, Reactive.Banana.Prim, Reactive.Banana.Prim.Cached other-modules: Control.Monad.Trans.ReaderWriterIO, Control.Monad.Trans.RWSIO, Reactive.Banana.Internal.Combinators, Reactive.Banana.Prim.Combinators, Reactive.Banana.Prim.Compile, Reactive.Banana.Prim.Dependencies, Reactive.Banana.Prim.Evaluation, Reactive.Banana.Prim.Graph, Reactive.Banana.Prim.IO, Reactive.Banana.Prim.OrderedBag, Reactive.Banana.Prim.Plumbing, Reactive.Banana.Prim.Test, Reactive.Banana.Prim.Types, Reactive.Banana.Prim.Util, Reactive.Banana.Types Test-Suite tests default-language: Haskell98 type: exitcode-stdio-1.0 hs-source-dirs: src main-is: Reactive/Banana/Test.hs build-depends: base >= 4.2 && < 5, HUnit >= 1.2 && < 2, test-framework >= 0.6 && < 0.9, test-framework-hunit >= 0.2 && < 0.4, reactive-banana, vault, containers, semigroups, transformers, unordered-containers, hashable, psqueues, pqueue reactive-banana-1.2.1.0/doc/0000755000000000000000000000000013415425603013627 5ustar0000000000000000reactive-banana-1.2.1.0/doc/frp-event.png0000644000000000000000000003554013415425603016252 0ustar0000000000000000PNG  IHDR2;u'yiCCPICC ProfilehPTMϙ9s9$Qr9#"IDD$ $H$ 1DDAQD {ڭڭs歮9-$$FAalvlD@ssQ7333DX~B fPLyCq>yAq;ЩDGDQP̀G{ ԕj ЄbWg^TPšgi=00zM~ 󹇄AcAsb77?k۲{c^@847jdjg0}/@9  0*඄Rp_'pCKUVTH Tq @@ #l  (J*hz!`Vpp^/@,,"Pe@%P 4-m#`X ?S @ dA!P@]@0 s`6X- 3" n FQXa|0 Lfsyat%X) {v`_s*p- OK7]c 'Ep# "GT"k}$$Gr %ZHk72,G" 7#ńEilPDT>ՋzZGqh$ZGg+]i(`0ޘdL3Y|Xe 6{{ۇ]8V< p_D<^og ('AH%: DK$#V$L$$$$$$K$G26ѤH{H~''S s$K"A6JM#%$! #OAN!GBq9%H)@iEDHJʆ*5Zڃz 1M"M32-V6vF7E^ޕ  B .  ~0 322N2berg*bf,\EŃ41k!/[]]vvSTo8h888nqprjpFp|΅R zʍV^AT,"yxx+yU  ~rz t,,!+\)L()'r[dGMN詘XXغ8xD-lW%R:RRR?C[xT˼e=#["\FZSy*y+BEjbN77x|Z>+K+* TU.,26~QWKSVTwTS!HFM摖EڡC:x[:/jyzz1z4w VuچEFrFFLLMMMCLhSZPXx[ XRXXYQYY [ZY0D<崍}b'hnl/mgPəGcSӄ3ss)K.\u]k\Oθ:zv]=}Cã^/o1<=C&_?ntM %^ K`RJr`P0ǰpߑNQQQ*'11C,Iq*qq'C , +ʉIgcȦZvQ͝;wtfddg\пАΜz]=uQb]23oϥKou//\,/*xJs!0p,:Q]T,W\Zĩd4tL[_>s]_+l*z+++nhިTWVWV9S3TQ{vΨ&͘j ؆FƲ&ɣiȭ[?Z[.iimv>ۑqxh@gA.;bwJn^Bodjn_{?Czǻvw \4ZK?8<9"5Rux?Q1qx%)i銇?rx45#70K;{a9ݹyB'O>UzڲȺ |͒s/X^俄|գe+\+Vq_{^Z3\ZX۠߸ nFnqz3Vm6v;];.;O qev/iGߏ?YW, ݗAW+Ծu |g~Gҏß?7~;=-4?Pi:">+J^e@ ЂHo# xBi "5:P 4@@t pRL u)P @k0b:xl!ς p<ia0aLf KeÊ`հ6哰E¹p5 _ }(!C!j3+D4DхxXB ~" HR/7=BPf(OT,*U|&9hS':]n@C?Ca&$㎉\Œb1X,/V k bob/_q8~k=mxV"7o pAp/ DRшO&6'H$$:$^$$$$ۤR~RR\Y}2r2I2kRA5r89/!y0e " &%Rw !36U U=w {7h4r4gihhВ*Ҏ1EU=;ϠC@P0#c..S"S *3 *ss E /V!Vg|ldz>[_`g`<r*:(ȃQie'W1_?@A`2D!a!o*W4f9D@%NOޢ5 I 3%I?%$%H~ j$-*{OFX&PE棬ll쾜\\ܡ||B¨"RQO1GqV\JX2rQp^ߪlyջjk\ИY%5MԶ֮ӉչKеѽ^OJ/IoJJYQ@ `ɐ0pcdeTeX8 I=SF#3fo%--B,-,]-;@+ jk-omll^ &qEM3ُ8P9x;!9v#ɱ wsnv]l\]AWf7[YY(w'NG'ר7wOςoK?I7JW?hx+L<2*&V^+:-y/>*"j6?\j|̕qq]~ l b9oԓʓ-[R0)gSSR#R O[?tt[`̈xzABLӬ3YaُsrrjV\t؟GإK =/^QRvg}aUWI}f~8xDb^Qis,QPynuJʼʏ7LoUUVWKT_Zc]]K[SNM4444bgD.7ܲL߼ҢRՊhjlݢNmG\m՝N.;6w7{tz!>+?vnO݃ CCB=.FLOL2Oܙ2f>7a#G>XͲf~zlxh{؂B'J=-_D,,>}n\y )/v^*eUչpkk-4Iۛfod5Vmmw ww+@ayWkyr/~oǎOt?79/&_0l5yHwtM[Qw7~xSgϓ_gm$iſ7?Qa:d1ր >߇@_qb2&!` x,/5? @dy@PT@st\> L /ꏃ CaLKTa0[;d LU 3N3pmO+! d{"!PE%9D!уBB!N!kB `dوDCEDdP(T* UBM^CƎG& 7G4#1`R0%4fsbD5l-1dqgjqøew<^o_Gc=A`M'\&f {Dek*4U*UcjnjSX4塵Mm}Fsˢۤ'W/`ɐ𚑄Q1q'?=S&S/;f:f=,Xy_R :%SkG׳?q(qqXDprrsr\R\\e\ 4r9dJ>=$N~V~k#2A``[!f!kBBo 19 mc,H%. #EBXWVbMINPr^(e uAjLVN> ه(,ANPOInG_OIBBGEQPNC%YXSeuʓ*xS+*K;j"jj}j9tuRZ8- 2Mm!ANΦnAFJoW_VmCCkoč{1T|4U65}e&`k6eNokgheidy򣕪e k) 666sGN1ۍ9P8x9=CzL#cݩיù߅eЕu؍-m,و9<<<^zJxf{nz)zzzk{Wx4|}gp.`%P6 p7H'*WMp{>+d814*t>L(BFrxqAIDS$25nmTX 11E1_bcq.qwig^'*$%~N2JO';'PL򤦦ɥ3eM}ݧWӏ+x"|AC CC'\ s9}Q_cc#\?0y1A=3<6Y; .]zu~fhc=sLssF Ot'<{BEK_U-VV*V_K.[ּ_[?81)Yy-ޭܭomfNygN??x+[{mo#{>ާޏYs/n_F{{8[ַ#^pHSgluO{Dөia?{6LG @JpBQ1XO\ BEKf@EQJ9@OCGp.".N)ťm!#/( +)&/),m-c *'-ϯH*(QYT}֫ޠQk/moh2`Z~J A!aFQV16q6 Iɚ) i稠+xrą̲\yؼO/(8ůT]kœ%-e1׵+*)+xS5SSS]WwӧަAQIK3e zgǯ'];n^>~Cʇ;F&~'}?520]峋3)$ž\~z{qٗ/$^Z [_i[}N4z;?' kWøoUG~2;]}27Oua$<aEZg,[!\&rSSPQKѐ|kaeea3fZn!ʉ]k%%+!$B-+:&V..a .Sj^Q&UNNL+pWR ʡu` 5M2Z :4zm 4ڍMLLYMFͯYZjZ1X}v@;Xlp]w:[a)Eا_Q` !p/h&5RhhETuķȥ蒘X8xāI).ji'7d\4ϒʦ;y5R|e+l£owT^-*OYX}ýʥڱƾ֮Mm]C-fж] wGz r 3>;{hڃI)i!.ܚznDgKϞyeҸr[wߓ}p>X,öE9{ej]9bqqx 6hOBJ2CAAvLGN)NCUOe+%tv 0L,,Yﰅ prq1r-qy+!BB".KbW$H$JfJHäeeew cJJoKTLTj|k%Z$Zڙ:8P^fXoh,md4֜d+kjufCӞ3a*NXΕ.R'ng==y{E{+ |}D$A$谙HȍѸxĶdƴsg\p6S.,k'{,Fn3y /ynA³Wu^VR2VRVTrݿ¶RD{5y kvݫ Í}M]ڛ[[ZZ[ wtܾ}{gwoݡèJc&'M b @ 0 b{dX?  rKNRP(S @%P4kxxyr Cn A4HEwX@P4-@{H0<1y_ ۄ0*3& C ayb:aݰC"l vx8 . kMp/>"x5 |BP"EYh"Qh@t#O} dB " Cz#DA#[o(ŋEQ~xT.: 5GmBVFӣhS:.A7[<&)4a0 m/,5z`c~cNjSYpb\+n<ρǛ})b|;~A 4 HB0LxA8 bIIIIH o}LK%!$s#K"+##[";$$'7%$%o""GЦHؤSrRjRSܢBQRSQPPRSSPKQPPQRixhih.ܦy,3:'mm+#']6]"Oz6zmz=+ sh q]F*FEFwlی/`LLLL5LYuCKGwYhXXX YXvX)YUX}Y YﱾgfSg `+fcggb׃}/5GG 'SӋ>>+1W-Xn9nkG<<<xzx]#U=G_ H @X&(#+x]p^)$/$T-$LV%.B#b$&#QKA艘XX+q q4~u$%$J%u$%{%?K JyJUH=6 }_LL̎,l\ܤY~@BmOŠMxH6666GZkvvv}{ 3Wl9J;f8>suqrfppt!uqstEں6U?[~v]5BOem/ewWw|T}|v}5}K}?Ub](ƂYcCC2BBB Ý{#"B"EE\R*mC(V 6+v;N'.?=!5a=Q=* L:t?39=y+E7!:&Vtoede,]PP͒͜*:Ȟ)9uϝ(~iW%KgU/7l^1]V]թ"k8z׊{KJKK}J4ʙʳʏ{\_Phd̩y*ݪjTMTZډ:ƛ 7sn_khkmllbjt v+Nc\VKopkUM[N;õm;:[Pc{|zz{ +߹+r~}lzn(}^ܽ._ڍ>37|`tB}ޤTߴtCݏݙ3+3Xq\Ђ'?}h8%ǥ߽xe_R+d+ELկ_ɬ k?ڰxMķE6x73!~fIӣ}azp[_G71cqo''˧df &Z_c7w6h@6 11yaq aq1{̓cJm`4?Ϙ)Ħ."w'acd? pHYs  IDATxylݖBERJ$ E\!֣BLD!* @+64 DX@ v5?ow[~Mdҽfkwξ'ɲ,H`hW(\ 2" #"1ȈHx 2" #"1ȈHx 2"V5jTۧLSrW_}Z8E lҥKmnwƔ)S®Qsdiii߿?vܩO?j"++ xѵkWL:W\it,>}Z#ܹsGFJJ f̘7nS]"2ȦLoFb„ X,Xt).\CcՍD}}}ܸqx'?l6Dd@p"77555Ν;uVa3f |>fXt)>@Νrn@nݺaȐ!صkRSSaZIpq,ZΝCǎѹs{<8q;EUUvn@2;Э[7L<$oߏ4lڴ _u+ڵkxdeeH}\MM 2&M4 %%%ؾ};ߏ;vYSRRpAmG2\v 6 >|8$IҢDd Y0|pv :0qD:u 4hJAΟ?sA?Ƒ#Gb޼y֭ _~ׯעDd0ދ};vDVVƎcwս]vaݺuM ȋxvcj+󡰰BO Zb):U?~gώXb^[dvjtbdj46EC=Gݾb dG͜9%%%CJJ |A\t n8s .^rzsȲUV!##ݻwQVVMbxXъ7nhr^޽{Q\\b\t Viii/O?ţ> Xt)*++Q^^UVaԩps˗رcسg|8zǃ5k֠ڵCff&RRRPVVgy7d2!33@vgXǏnnܸz {Űa좑*Avq$It(Mw}cdbrqqq#GToZ3gΞ=3fSXXgϞݻ7^xf=;wF~гgO,[3l0,YcƌAzz:^y=ٟxEu]KI sW r먮ƕ+W0qD˗/pM6ŋxХKfsU$&&ND$a۶mh׮6m 66111X,L#;v1{n{mqydl|k "1ȈHx 2" #"1ȈHx 2(EYQVia: 1Y< ƚ |&:i/pqYd~(6 4IYe\ 4Lc-1 Պ"먭B}}=<^oןL&X,XVv".. tCVQˌ P`RiY,nvL&un.(llp8nWFBƔfCLL bn[]h3c$IjkfnYLL l6[Pcebi,0l6Ҹ2rVlC.Z,UYll*SŒ]K14bVU]e\ )v \8ffk4V0Lcatwx<K*5VXV% ,0j8)c*fYj|>5ȔI M*-~dR8Ni*.H+l vUUU8qzd\.8# 97777ZۈbسgΝ;k׮a0zС#|yDbREEEpJJJpذa!# (--ŸqPZZN:ӦMCyy9~icdp:СCo "Sp"2|Lc!2Vd>Z!2VdDd\kID #"1ȈHx 2" #"1ȈHx 2"n>4p9s&*D;bɒ%ʂln>>h"aڵۍϣw޺vEFdpgϞEII &Mmb?lffldR9s+WO>ɓѳgO|زe A1׭[`ϵ%(rDBBB @,p8=z+W]֬K̙3r>}dY IIIM۷˒$rEEnT##GeyAq;ЩDGDQP̀G{ ԕj ЄbWg^TPšgi=00zM~ 󹇄AcAsb77?k۲{c^@847jdjg0}/@9  0*඄Rp_'pCKUVTH Tq @@ #l  (J*hz!`Vpp^/@,,"Pe@%P 4-m#`X ?S @ dA!P@]@0 s`6X- 3" n FQXa|0 Lfsyat%X) {v`_s*p- OK7]c 'Ep# "GT"k}$$Gr %ZHk72,G" 7#ńEilPDT>ՋzZGqh$ZGg+]i(`0ޘdL3Y|Xe 6{{ۇ]8V< p_D<^og ('AH%: DK$#V$L$$$$$$K$G26ѤH{H~''S s$K"A6JM#%$! #OAN!GBq9%H)@iEDHJʆ*5Zڃz 1M"M32-V6vF7E^ޕ  B .  ~0 322N2berg*bf,\EŃ41k!/[]]vvSTo8h888nqprjpFp|΅R zʍV^AT,"yxx+yU  ~rz t,,!+\)L()'r[dGMN詘XXغ8xD-lW%R:RRR?C[xT˼e=#["\FZSy*y+BEjbN77x|Z>+K+* TU.,26~QWKSVTwTS!HFM摖EڡC:x[:/jyzz1z4w VuچEFrFFLLMMMCLhSZPXx[ XRXXYQYY [ZY0D<崍}b'hnl/mgPəGcSӄ3ss)K.\u]k\Oθ:zv]=}Cã^/o1<=C&_?ntM %^ K`RJr`P0ǰpߑNQQQ*'11C,Iq*qq'C , +ʉIgcȦZvQ͝;wtfddg\пАΜz]=uQb]23oϥKou//\,/*xJs!0p,:Q]T,W\Zĩd4tL[_>s]_+l*z+++nhިTWVWV9S3TQ{vΨ&͘j ؆FƲ&ɣiȭ[?Z[.iimv>ۑqxh@gA.;bwJn^Bodjn_{?Czǻvw \4ZK?8<9"5Rux?Q1qx%)i銇?rx45#70K;{a9ݹyB'O>UzڲȺ |͒s/X^俄|գe+\+Vq_{^Z3\ZX۠߸ nFnqz3Vm6v;];.;O qev/iGߏ?YW, ݗAW+Ծu |g~Gҏß?7~;=-4?Pi:">+J^e@ ЂHo# xBi "5:P 4@@t pRL u)P @k0b:xl!ς p<ia0aLf KeÊ`հ6哰E¹p5 _ }(!C!j3+D4DхxXB ~" HR/7=BPf(OT,*U|&9hS':]n@C?Ca&$㎉\Œb1X,/V k bob/_q8~k=mxV"7o pAp/ DRшO&6'H$$:$^$$$$ۤR~RR\Y}2r2I2kRA5r89/!y0e " &%Rw !36U U=w {7h4r4gihhВ*Ҏ1EU=;ϠC@P0#c..S"S *3 *ss E /V!Vg|ldz>[_`g`<r*:(ȃQie'W1_?@A`2D!a!o*W4f9D@%NOޢ5 I 3%I?%$%H~ j$-*{OFX&PE棬ll쾜\\ܡ||B¨"RQO1GqV\JX2rQp^ߪlyջjk\ИY%5MԶ֮ӉչKеѽ^OJ/IoJJYQ@ `ɐ0pcdeTeX8 I=SF#3fo%--B,-,]-;@+ jk-omll^ &qEM3ُ8P9x;!9v#ɱ wsnv]l\]AWf7[YY(w'NG'ר7wOςoK?I7JW?hx+L<2*&V^+:-y/>*"j6?\j|̕qq]~ l b9oԓʓ-[R0)gSSR#R O[?tt[`̈xzABLӬ3YaُsrrjV\t؟GإK =/^QRvg}aUWI}f~8xDb^Qis,QPynuJʼʏ7LoUUVWKT_Zc]]K[SNM4444bgD.7ܲL߼ҢRՊhjlݢNmG\m՝N.;6w7{tz!>+?vnO݃ CCB=.FLOL2Oܙ2f>7a#G>XͲf~zlxh{؂B'J=-_D,,>}n\y )/v^*eUչpkk-4Iۛfod5Vmmw ww+@ayWkyr/~oǎOt?79/&_0l5yHwtM[Qw7~xSgϓ_gm$iſ7?Qa:d1ր >߇@_qb2&!` x,/5? @dy@PT@st\> L /ꏃ CaLKTa0[;d LU 3N3pmO+! d{"!PE%9D!уBB!N!kB `dوDCEDdP(T* UBM^CƎG& 7G4#1`R0%4fsbD5l-1dqgjqøew<^o_Gc=A`M'\&f {Dek*4U*UcjnjSX4塵Mm}Fsˢۤ'W/`ɐ𚑄Q1q'?=S&S/;f:f=,Xy_R :%SkG׳?q(qqXDprrsr\R\\e\ 4r9dJ>=$N~V~k#2A``[!f!kBBo 19 mc,H%. #EBXWVbMINPr^(e uAjLVN> ه(,ANPOInG_OIBBGEQPNC%YXSeuʓ*xS+*K;j"jj}j9tuRZ8- 2Mm!ANΦnAFJoW_VmCCkoč{1T|4U65}e&`k6eNokgheidy򣕪e k) 666sGN1ۍ9P8x9=CzL#cݩיù߅eЕu؍-m,و9<<<^zJxf{nz)zzzk{Wx4|}gp.`%P6 p7H'*WMp{>+d814*t>L(BFrxqAIDS$25nmTX 11E1_bcq.qwig^'*$%~N2JO';'PL򤦦ɥ3eM}ݧWӏ+x"|AC CC'\ s9}Q_cc#\?0y1A=3<6Y; .]zu~fhc=sLssF Ot'<{BEK_U-VV*V_K.[ּ_[?81)Yy-ޭܭomfNygN??x+[{mo#{>ާޏYs/n_F{{8[ַ#^pHSgluO{Dөia?{6LG @JpBQ1XO\ BEKf@EQJ9@OCGp.".N)ťm!#/( +)&/),m-c *'-ϯH*(QYT}֫ޠQk/moh2`Z~J A!aFQV16q6 Iɚ) i稠+xrą̲\yؼO/(8ůT]kœ%-e1׵+*)+xS5SSS]WwӧަAQIK3e zgǯ'];n^>~Cʇ;F&~'}?520]峋3)$ž\~z{qٗ/$^Z [_i[}N4z;?' kWøoUG~2;]}27Oua$<aEZg,[!\&rSSPQKѐ|kaeea3fZn!ʉ]k%%+!$B-+:&V..a .Sj^Q&UNNL+pWR ʡu` 5M2Z :4zm 4ڍMLLYMFͯYZjZ1X}v@;Xlp]w:[a)Eا_Q` !p/h&5RhhETuķȥ蒘X8xāI).ji'7d\4ϒʦ;y5R|e+l£owT^-*OYX}ýʥڱƾ֮Mm]C-fж] wGz r 3>;{hڃI)i!.ܚznDgKϞyeҸr[wߓ}p>X,öE9{ej]9bqqx 6hOBJ2CAAvLGN)NCUOe+%tv 0L,,Yﰅ prq1r-qy+!BB".KbW$H$JfJHäeeew cJJoKTLTj|k%Z$Zڙ:8P^fXoh,md4֜d+kjufCӞ3a*NXΕ.R'ng==y{E{+ |}D$A$谙HȍѸxĶdƴsg\p6S.,k'{,Fn3y /ynA³Wu^VR2VRVTrݿ¶RD{5y kvݫ Í}M]ڛ[[ZZ[ wtܾ}{gwoݡèJc&'M b @ 0 b{dX?  rKNRP(S @%P4kxxyr Cn A4HEwX@P4-@{H0<1y_ ۄ0*3& C ayb:aݰC"l vx8 . kMp/>"x5 |BP"EYh"Qh@t#O} dB " Cz#DA#[o(ŋEQ~xT.: 5GmBVFӣhS:.A7[<&)4a0 m/,5z`c~cNjSYpb\+n<ρǛ})b|;~A 4 HB0LxA8 bIIIIH o}LK%!$s#K"+##[";$$'7%$%o""GЦHؤSrRjRSܢBQRSQPPRSSPKQPPQRixhih.ܦy,3:'mm+#']6]"Oz6zmz=+ sh q]F*FEFwlی/`LLLL5LYuCKGwYhXXX YXvX)YUX}Y YﱾgfSg `+fcggb׃}/5GG 'SӋ>>+1W-Xn9nkG<<<xzx]#U=G_ H @X&(#+x]p^)$/$T-$LV%.B#b$&#QKA艘XX+q q4~u$%$J%u$%{%?K JyJUH=6 }_LL̎,l\ܤY~@BmOŠMxH6666GZkvvv}{ 3Wl9J;f8>suqrfppt!uqstEں6U?[~v]5BOem/ewWw|T}|v}5}K}?Ub](ƂYcCC2BBB Ý{#"B"EE\R*mC(V 6+v;N'.?=!5a=Q=* L:t?39=y+E7!:&Vtoede,]PP͒͜*:Ȟ)9uϝ(~iW%KgU/7l^1]V]թ"k8z׊{KJKK}J4ʙʳʏ{\_Phd̩y*ݪjTMTZډ:ƛ 7sn_khkmllbjt v+Nc\VKopkUM[N;õm;:[Pc{|zz{ +߹+r~}lzn(}^ܽ._ڍ>37|`tB}ޤTߴtCݏݙ3+3Xq\Ђ'?}h8%ǥ߽xe_R+d+ELկ_ɬ k?ڰxMķE6x73!~fIӣ}azp[_G71cqo''˧df &Z_c7w6h@6 11yaq aq1{̓cJm`4?Ϙ)Ħ."w'acd? pHYs   IDATxyXT, & J (*jaP#5E|,).^[i₥DY^1E 2̜\6̙g9fxa@!<&B!(!GAF= 2BQBx{dޣ #!(!U}6lX'M.d|GڬBXZYdd$rssq6BCaҤIZG!UIRx{{###ĉ@pp0=_~½{Z7n+(-->|80m4hS.!Di=G6i$߿X,ƢE_~jɭGCCCr9jjj0rHɓD:uBLXz-ǣ vvvݻQ__d1* mw{쁇-ZXr%\]]QWWm&GVV<<<`aaCB ʕ+?>JKKWWǶREEE(((hRDyy9ݵ-bB2w}OOOL82 qqq!JbΝm.9Hmmm-߿Cpp0> ]tEɄ|Mطo"##<饗 JVwߡj!//w^aÆ!''߇D"ѣG@ !&D'A XYYׯcРAqfΚ5 3g΄7>{ܹs7\B#׮]b1!H`ee1P(xgZ-_^^RDBxJAF?5iN&Ia!44A׉~QAR`qP(d\ `(tLN\T*ei#вǥ .HPdBrD(tiT*ұcGK#RUUHHlQ5NT*(J(J4666.@\ fH$bD(tpRd r҈544!~6ݣ ӱFfG OzkKs!CAC-C \F ٤?QX0 +Gf^ ! oGBm%͑\BnjCٽ{ <5_ 2ͷdE.} #Ym۶ :t_U zK\1\b4?΂l*A/J%4AF ;{,޽ azΞ=Ez.Jw\.ǭ[p=Ѳiiir^vVXQ˞ + ۴iM^CC6nEzV #F|}}Q\\ܮe7l؀륮rm( AP(k.R BaRt零Ő www\pի @ZZeLky!g jaP(lul MRa…@=j˗ y&{'[o{xtR466bȐ!z[ظq#Я_?UTT#FcǎׯN8w%=%%%;v,:vv=R,Xݻ7ڵ/Ybbb3Դy^r9f;wse[h󑛛k"** III(((#GDs^{ yyy AII ,,, Jaz|xWagg{b(,,lUgpp0^|E\r3gرcٳ_EDD"##[nATȑ#شig ={X;ֶ]oRxwԩS???xIƍ9nnnaСRRR J1rH>c!22prrb5kv܉j@jj*ѣGBݺukUÇq$&& ^xlݺ}LEE,Yɓ'~OMMEqq1֮] xzz>ʕ+Bee%VSSoMnp9TVV  BPPmmlly3g`ܸqm^@~f5sylׯ_,--qf%,,oɒ%m̙33f hfh_K%=h!p18::LC0 \w0 Ǐ7kcHHH@~PUUQF=>'''6;FWAAj_bj}l;w`˖-۷/gn9r$>31ϟoj%w}/f{&L@EEOYf[!!!Ix瑝dggc͚5P(㾉 317n܀3PSS;v"//={}]vGYnRSSFZi9s&JJJ0mڴ6(,,3bbbHMMŬY$$$ ((H?|tNNNO?@,DvqdQuuuQ]]JܻwF\޽ kkkڶ{qt}Ztڵ| I `޽ppp@N`oo[[[bK$](E.Bp>!GAF= 2BQBx{dޣ ӑgny̋ݣ0=hbdESxX[!&.P3Smٯ'Ӝmh}t b4g? 2kك*TWWuuuhhh@cc#J%6GB!b1,,,`eetЁ=`5o3#CACMX,%P(ؓBH$6 2мOѡCX[[ʊ9\3k:$AA#-4C DKKKX[[!]Pg6#clo["ʪYYZZB"4^\~QX H$5nmm B+GX,f{e0a{e0QP`2 )0SP!Ԅ΁6 35$I2 3 ӱa2j>---)þб`{bbDAC780Dl8iTD";TTlP~ӞX~ 3 !͡n;[,7 !FAYsZnKFA?d:y6}j93aZ(C7 3M[jל60 2kD͂L\}[ӀjXM?(΢G-{\mLԲ:/Q7r[EA_m7( O= 2BQBx{dޣ #!h;2BpmTVV ~~~mi…  T*]"$$=呇 #;v ÇѣQZZ˗/ɓ(++CLL f̘iӦRI 8!鉜 :⣏>ÇqqJ04GFݻwt߿N:R0d-\SNk֮/X"8<\!y 2bN<\\t鉖7or9BCCqiB4GFڠA0gL<;w.푐\ İ/OVVVrSY'OĪUtXyR##f+((ÛoU;L 8PGՑ'A=2bN>rDDDhVn7୷Buu#Ozd,M8￯6gΜ @͛7M>d씕A*:kR۶mȑ#u.y<Z}vDDD4۶mQ[[ӶɣQ/// @/O2HLLK5 2bVd2x'qmHR:u }zВm۶aڴiz]>S̚5K!C=2b6ѵkWERâE0i$Pt ߿u9&dj899~43g( |\bGf"j5%LWWW 1HLLǑu)&N#qid2ܼyuuuRD=Я_?L4 !!!H$\̩LL02dkk8p }YK5Zjb֭())A@@0d666ĥK/ %%ׯ_'|wy޽{cΝ㺔Zt)򐝝 Hu9EAf.^Dvch5d2,YB_5<==Xz* 2Ky$a0~x466ѣ\[4Gfd](1իWw' 19995jq)=Ul2331~xx,@LܼyO^__;v $$NNNzqzrmf錃l2Fgm۷>}ZgmÇ3二v￙ѣG3 b._66626mb\\\&33? Tq Zfl8::2K,a***~qqqavڥIee%ckkq]T.]hȑ#LCC{ii)_2nnnLHHsy5.dt3tPߟ_tڕʌ;2Zee%b fȐ!LNOOOc:w̄3 %0HJJBRR0k,øqO?wYM2CŌ3.Ek@ ;}dVVV(rٳ]v5x ;v@BBΜ9gy'JGGG\p-}ki@YYYq)~m눈J}A!ff( @T"66>g$%%𓕕cr]10Z۷{{{qzҖnݺ___dffߟrtB*b֭b@#ӣ3O⺔vSpttD~~>uu9#BJJ Lt1P\\̫cd2S1 gaҥA`` H$š5kpB466r]N D(ȞZܹssN$ѫW/lذRڅ͑=\(###\7>|8._lG(**/RGNxW! m!GBBץr81o'OӁΝ;cui֭6|LT"::ʂ^gN兴4nnn(**^EǤ{dCHHq) 1 rd49Bd?K/a$Z۷u=[la%y(Z۷111X~=g;BCCqFTT^Jʐ6T1 xl߾Yf̘;;;^ZmO8AAA;w&dݻ}͍QBx& !GAF= 2BQBx{dޣ #!(!GAF= 2BQBx{dޣ #!(!rJ6/ݻ7%#bR)\\\pBC${YJJ?>i&B͛7套1q%%%osΘ7o.^خeE"$ $ D"B!{qq1WFRR&N={bժUHKK?___l_}|||uI2x{{{{Ō5ӣGfDGGd2gabccN:1~-o>F 0 bd2Ì=adݙC1///f׮]Z?GO0 Zfu~olll?T*T*q5,] ,h?3aL<àA0 ~m1{l30o<޽Z  χ]~_,u}|nݠP(Y[[SN={6O9D1IDATnݺ---!Jb]QQ~7$''r9z9 2]| BJ={6%1qD@cccӠ~BL|}}qFTTT %%E!^Æ CFFۋ3gVXu- ![[[|';v,{9j`͚5Zvd0 ]ٳNڤ #͑Bx{dޣ #!(!GAF= 2BQBx{d?n IENDB`reactive-banana-1.2.1.0/doc/frp-stepper.png0000644000000000000000000005045613415425603016616 0ustar0000000000000000PNG  IHDRU&='yiCCPICC ProfilehPTMϙ9s9$Qr9#"IDD$ $H$ 1DDAQD {ڭڭs歮9-$$FAalvlD@ssQ7333DX~B fPLyCq>yAq;ЩDGDQP̀G{ ԕj ЄbWg^TPšgi=00zM~ 󹇄AcAsb77?k۲{c^@847jdjg0}/@9  0*඄Rp_'pCKUVTH Tq @@ #l  (J*hz!`Vpp^/@,,"Pe@%P 4-m#`X ?S @ dA!P@]@0 s`6X- 3" n FQXa|0 Lfsyat%X) {v`_s*p- OK7]c 'Ep# "GT"k}$$Gr %ZHk72,G" 7#ńEilPDT>ՋzZGqh$ZGg+]i(`0ޘdL3Y|Xe 6{{ۇ]8V< p_D<^og ('AH%: DK$#V$L$$$$$$K$G26ѤH{H~''S s$K"A6JM#%$! #OAN!GBq9%H)@iEDHJʆ*5Zڃz 1M"M32-V6vF7E^ޕ  B .  ~0 322N2berg*bf,\EŃ41k!/[]]vvSTo8h888nqprjpFp|΅R zʍV^AT,"yxx+yU  ~rz t,,!+\)L()'r[dGMN詘XXغ8xD-lW%R:RRR?C[xT˼e=#["\FZSy*y+BEjbN77x|Z>+K+* TU.,26~QWKSVTwTS!HFM摖EڡC:x[:/jyzz1z4w VuچEFrFFLLMMMCLhSZPXx[ XRXXYQYY [ZY0D<崍}b'hnl/mgPəGcSӄ3ss)K.\u]k\Oθ:zv]=}Cã^/o1<=C&_?ntM %^ K`RJr`P0ǰpߑNQQQ*'11C,Iq*qq'C , +ʉIgcȦZvQ͝;wtfddg\пАΜz]=uQb]23oϥKou//\,/*xJs!0p,:Q]T,W\Zĩd4tL[_>s]_+l*z+++nhިTWVWV9S3TQ{vΨ&͘j ؆FƲ&ɣiȭ[?Z[.iimv>ۑqxh@gA.;bwJn^Bodjn_{?Czǻvw \4ZK?8<9"5Rux?Q1qx%)i銇?rx45#70K;{a9ݹyB'O>UzڲȺ |͒s/X^俄|գe+\+Vq_{^Z3\ZX۠߸ nFnqz3Vm6v;];.;O qev/iGߏ?YW, ݗAW+Ծu |g~Gҏß?7~;=-4?Pi:">+J^e@ ЂHo# xBi "5:P 4@@t pRL u)P @k0b:xl!ς p<ia0aLf KeÊ`հ6哰E¹p5 _ }(!C!j3+D4DхxXB ~" HR/7=BPf(OT,*U|&9hS':]n@C?Ca&$㎉\Œb1X,/V k bob/_q8~k=mxV"7o pAp/ DRшO&6'H$$:$^$$$$ۤR~RR\Y}2r2I2kRA5r89/!y0e " &%Rw !36U U=w {7h4r4gihhВ*Ҏ1EU=;ϠC@P0#c..S"S *3 *ss E /V!Vg|ldz>[_`g`<r*:(ȃQie'W1_?@A`2D!a!o*W4f9D@%NOޢ5 I 3%I?%$%H~ j$-*{OFX&PE棬ll쾜\\ܡ||B¨"RQO1GqV\JX2rQp^ߪlyջjk\ИY%5MԶ֮ӉչKеѽ^OJ/IoJJYQ@ `ɐ0pcdeTeX8 I=SF#3fo%--B,-,]-;@+ jk-omll^ &qEM3ُ8P9x;!9v#ɱ wsnv]l\]AWf7[YY(w'NG'ר7wOςoK?I7JW?hx+L<2*&V^+:-y/>*"j6?\j|̕qq]~ l b9oԓʓ-[R0)gSSR#R O[?tt[`̈xzABLӬ3YaُsrrjV\t؟GإK =/^QRvg}aUWI}f~8xDb^Qis,QPynuJʼʏ7LoUUVWKT_Zc]]K[SNM4444bgD.7ܲL߼ҢRՊhjlݢNmG\m՝N.;6w7{tz!>+?vnO݃ CCB=.FLOL2Oܙ2f>7a#G>XͲf~zlxh{؂B'J=-_D,,>}n\y )/v^*eUչpkk-4Iۛfod5Vmmw ww+@ayWkyr/~oǎOt?79/&_0l5yHwtM[Qw7~xSgϓ_gm$iſ7?Qa:d1ր >߇@_qb2&!` x,/5? @dy@PT@st\> L /ꏃ CaLKTa0[;d LU 3N3pmO+! d{"!PE%9D!уBB!N!kB `dوDCEDdP(T* UBM^CƎG& 7G4#1`R0%4fsbD5l-1dqgjqøew<^o_Gc=A`M'\&f {Dek*4U*UcjnjSX4塵Mm}Fsˢۤ'W/`ɐ𚑄Q1q'?=S&S/;f:f=,Xy_R :%SkG׳?q(qqXDprrsr\R\\e\ 4r9dJ>=$N~V~k#2A``[!f!kBBo 19 mc,H%. #EBXWVbMINPr^(e uAjLVN> ه(,ANPOInG_OIBBGEQPNC%YXSeuʓ*xS+*K;j"jj}j9tuRZ8- 2Mm!ANΦnAFJoW_VmCCkoč{1T|4U65}e&`k6eNokgheidy򣕪e k) 666sGN1ۍ9P8x9=CzL#cݩיù߅eЕu؍-m,و9<<<^zJxf{nz)zzzk{Wx4|}gp.`%P6 p7H'*WMp{>+d814*t>L(BFrxqAIDS$25nmTX 11E1_bcq.qwig^'*$%~N2JO';'PL򤦦ɥ3eM}ݧWӏ+x"|AC CC'\ s9}Q_cc#\?0y1A=3<6Y; .]zu~fhc=sLssF Ot'<{BEK_U-VV*V_K.[ּ_[?81)Yy-ޭܭomfNygN??x+[{mo#{>ާޏYs/n_F{{8[ַ#^pHSgluO{Dөia?{6LG @JpBQ1XO\ BEKf@EQJ9@OCGp.".N)ťm!#/( +)&/),m-c *'-ϯH*(QYT}֫ޠQk/moh2`Z~J A!aFQV16q6 Iɚ) i稠+xrą̲\yؼO/(8ůT]kœ%-e1׵+*)+xS5SSS]WwӧަAQIK3e zgǯ'];n^>~Cʇ;F&~'}?520]峋3)$ž\~z{qٗ/$^Z [_i[}N4z;?' kWøoUG~2;]}27Oua$<aEZg,[!\&rSSPQKѐ|kaeea3fZn!ʉ]k%%+!$B-+:&V..a .Sj^Q&UNNL+pWR ʡu` 5M2Z :4zm 4ڍMLLYMFͯYZjZ1X}v@;Xlp]w:[a)Eا_Q` !p/h&5RhhETuķȥ蒘X8xāI).ji'7d\4ϒʦ;y5R|e+l£owT^-*OYX}ýʥڱƾ֮Mm]C-fж] wGz r 3>;{hڃI)i!.ܚznDgKϞyeҸr[wߓ}p>X,öE9{ej]9bqqx 6hOBJ2CAAvLGN)NCUOe+%tv 0L,,Yﰅ prq1r-qy+!BB".KbW$H$JfJHäeeew cJJoKTLTj|k%Z$Zڙ:8P^fXoh,md4֜d+kjufCӞ3a*NXΕ.R'ng==y{E{+ |}D$A$谙HȍѸxĶdƴsg\p6S.,k'{,Fn3y /ynA³Wu^VR2VRVTrݿ¶RD{5y kvݫ Í}M]ڛ[[ZZ[ wtܾ}{gwoݡèJc&'M b @ 0 b{dX?  rKNRP(S @%P4kxxyr Cn A4HEwX@P4-@{H0<1y_ ۄ0*3& C ayb:aݰC"l vx8 . kMp/>"x5 |BP"EYh"Qh@t#O} dB " Cz#DA#[o(ŋEQ~xT.: 5GmBVFӣhS:.A7[<&)4a0 m/,5z`c~cNjSYpb\+n<ρǛ})b|;~A 4 HB0LxA8 bIIIIH o}LK%!$s#K"+##[";$$'7%$%o""GЦHؤSrRjRSܢBQRSQPPRSSPKQPPQRixhih.ܦy,3:'mm+#']6]"Oz6zmz=+ sh q]F*FEFwlی/`LLLL5LYuCKGwYhXXX YXvX)YUX}Y YﱾgfSg `+fcggb׃}/5GG 'SӋ>>+1W-Xn9nkG<<<xzx]#U=G_ H @X&(#+x]p^)$/$T-$LV%.B#b$&#QKA艘XX+q q4~u$%$J%u$%{%?K JyJUH=6 }_LL̎,l\ܤY~@BmOŠMxH6666GZkvvv}{ 3Wl9J;f8>suqrfppt!uqstEں6U?[~v]5BOem/ewWw|T}|v}5}K}?Ub](ƂYcCC2BBB Ý{#"B"EE\R*mC(V 6+v;N'.?=!5a=Q=* L:t?39=y+E7!:&Vtoede,]PP͒͜*:Ȟ)9uϝ(~iW%KgU/7l^1]V]թ"k8z׊{KJKK}J4ʙʳʏ{\_Phd̩y*ݪjTMTZډ:ƛ 7sn_khkmllbjt v+Nc\VKopkUM[N;õm;:[Pc{|zz{ +߹+r~}lzn(}^ܽ._ڍ>37|`tB}ޤTߴtCݏݙ3+3Xq\Ђ'?}h8%ǥ߽xe_R+d+ELկ_ɬ k?ڰxMķE6x73!~fIӣ}azp[_G71cqo''˧df &Z_c7w6h@6 11yaq aq1{̓cJm`4?Ϙ)Ħ."w'acd? pHYs   IDATx{\Tu0p,@@@mVdfO^U@WlfY[Q芷&" (rg{3\T35a̜0s~sJ!@DDDFi0􉈈CJ0􉈈CJ0􉈈CJ0􉈈CJ0􉈈4666-JhT l3 Bp*JBͰfp>`Y >`Y >`Y >`Y  ܺu4{{{nZ/;;AMak˯#BٳvO h ZOMMZ͛7L?p\]]QVVV~gtԩ!/M&]ooo >ƪUusrr0ṡ~T7 `dddذaC&5o&Zcĉ1y{>oXdIcbX2зo_XGADD fQmW^ҥ 8ٳgۇ7@MzEEEضmC7@)))*]k.<u~qz M0k֬ANNڴito}vk,e8y$TnFzz:tpe}&L}z8q"nܸ'#FѣGk<߯k֬A\\3g΄y$%%5\r BBBgyׯ_s/]???:t?,u[2̙33f ʮ 8pӧȑ#Xz50h Ν;$!p):u 5//}A^^BCC SN!33kfff65iu=<(O?FÇ#!!< ڵkɓ'#//<k׮ɷ ,@ZZ~iaڴi(,,l7efBٳ'0`dggiWc͚58|0郧z  ॗ^?bccԴk.,֮] q0``ѢEHMMũSGaҤI㭷ŋk֬?Gyy9V^իWc])^gb̘1}QڲeK}QQQX~=°qFKpssCZZ***M@^/ߞ={:߇V''&yMj::t@>}h4 2* /_Ƃ ooo}}}}8p XYTTQFa sRݟYB?,, K.ѣGh0p@F?o!DT*UMh4\pAf180 =z@bbҥԩSxb;wi}*<< ǏǑ#GgL0@ {0ػwoc[?v-O:t(?;w@"!!?~+#F{/um~Gb޼y5^;;;:|Iף@宺On{,..ƍ1w܇~nccUO׿U)))Yf;w"22RODEEUOOO^^^WO=ZYF!đ#Gիpuu+W4W5'N⣏>~///1hР:"^?_귫>&"//O 4HN:~AQ٧{n6lGu wwwѷo_Ѷm[QRRz ܄8ܧojĈ|X;@+C3~婁DΝyyyK.bGbժUK:tJƍZݺu]v؟ŋ ѫW//?h7w;wݻwC 999[.-[LhZ/|}}o!?Gj|||=zߪԴh"-z-:u$bbb}]V {{,P Qaƍprr V1h۶m痕h۶mnPW |}}4ŋѥKeeeIܺu pvv~疖_E```1dggBddd(((VѭW\\ NGysssnݺA6Z]q\\\f~@vi{WHϟdz>WB3+//G^^^Kk3=[ KR&siIߥ˗#77}YЗvZ.xc"" 7h zCgZ.Lu3OKDDd%DDDVODDd%DDDVODDd%DDDVODDd%xpPT-?&saa,̃Y n'"" }"""+'"" }"""+'"" }"""+x觧ݻJAD-^Dž .ER4KKKѹsg,YD28qwǏ+] Qh۷غu+ Q ~zj_^RZ$EC?66EEEBJBD\aa! 7 .Q,W\?3J!`ݰ<]F]Q,+o!9|!fN2T(*\QˣX(++ok4l߾]rKL|2222eR$O>*ӊ˝j_h4Vf4qF*"j9/#G@RAAJJJp6uIDԌT*888Ti3z=t:xvpUE7n܈f͚%bQ 8s mF߾},QdMJ*Q ?oڴ 3l2d(l3OQQm-Y>4k7Y z5o?QDTFQ!2  FyD<1VRK^QQ޽{cر(**^GEEDCB-WTT@ZjcǢ@~g5_ }"Ia-v  //zOԌq=&Pw9~Mz= z3f 55۶m#<[[*ؘ}p c5#k֜e/N;w\֨(:u [l4 `kk Z ZmgAT }Fb:z?NөPf})ѧO5꫈Ƕm ;;Z0.}l35)MwwV}_$ t:t:Cu ضmڵkWlll D b5З-|V°uVO,>}Mhɒ%Cxx8n݊N:8?rD^}n…ppp@xx8lقnݺ8?2Df&KGKKK.IDEEAbĉC=j}1̬z_NCYYʔ.̘1vvvx ^~e;0`Zjggg888@BV9>XzA222 /_~AII<...8|0z`-Y;曘6mzgggsκJII^}UF 8ݻw.ܸUBU?`Peڵ /2?SN9k?xe5=ZӥcǎȨ@[n'P?Ӳ5lق۷oCbuիW/\p׿l2\\\> ((H*v&=k?Fk|ԕUZ/W\A`` |.hӦ RRRϴlf c~P9:=,,L~~~PT6Gt/HMMɓwrrO?K.q~=%mmmayפƍ3Ǭ-vB~~>Ν/񈏏2Џ,|Oo`񁭭-4 j|Bj_-[WƷ~ WWWKk̲͛7@ǎ# ,,O۷QRR4Ahh(ڶm upuuEVЪU+899A!`kk+o kh3Yw٫W\ɂHHʻݽ{WVRR*Q4PRm;wuy]d 6l؀PxzzUVpqqzjCf՟oo$RFޜjaooN!j5Zm(4 I׵Y`mۆC^wvvcf|"2>AFĦjaggF_բ\VC#z5"<<nnnpvvwttܷov'jZ }"33occF;;;9إhZD<pRTxWpQL4 prr...4_Vxj]'j$f}_+Wh4r7Я~v@N'h4b1u*kpuu7ګ>p#C@!Rt (hz%RK' Ņ 0sLyPV/mDC̤0Bk48ᰴM`ooD(s̑7Kwrr_'jQ#0=t$kJ/ Go߾rK[-GGG899yl3ꏡOH7 _}^P>kR𗗗1V i)3D DD}R?=~|4RxKnB]t挡OHʘPkK}i4@:F:N"`G x1ҵt>Q'jd5 uG@J`0T9@?VPvM쥓0>QW6`~{`)ХMgc5O }"_=[LnQa߼y3gggL:ÇZit~2M%`:HB[12݋7|?QfgΜ{ ,8z >Dփv'4=`S= 3˚+0sLӧ1h s̚TX}EE兤$!z(f }8;; sɓ'1}ts̚)%ի␝C"&&F鲈lg|2zk׮!%%5УG& OIDAT\|%%%R,_#F͛7ҧu 6 K.ԩSCh[|rJBt_fY_r%ƏЁODTҮMyIHHs]0x`DDD(i՝YvK.Uַo_$''?CP?ׯXzQsSQtQQQya߾}ѿj!zX }"jQf՟FQ'"" }"""+'"" }"""+'"" }"""+'"" }"""+'"" }"""+'"" }"""+'""f ~ cǎ5,* 3gT""&c/**—_~ &ɓes)] Q***///$%%)]Y~AAΝ;ooos̮Q!كӧ#==YYY۷o+QQի␝C"&&Fi6PRRFR%uLeggc޽2)j!k6C)  Eii) < ͛`ԒY@<صkhӦ "##Q^^1cƠ{VL"jR2rHU |(..ӧyf9Y W_}G㑔ш{HNNF6m.WBh8;;CVWy]''' < sVO 3gΞ= 777vvvJGD`sptt888`ժUpԒYU觤QTT#F 00{Q2"׾}{"""8~8,XtYd*w܉7o"$$7oٳgcǎ!//Odׯ͛7ѿ! a* G?U M6!""MR՟'jLVD ?ڼODDdDDDVODDd%DDDVODDd%DDDVODDd%DDDVODDd%Dxye˖iiiJIDڌӧk׮J%``,X_PHOOGaoodVm5Gk3t:~7tYpM,ؿo|(--}jhZhZjTxbdeeܹs0a֬Y;"44iii:t(n:yiiixiӦМooѣG~mFff&VXXn>CcǎXv-v؁.]'3gynذ?8qƚ=2bk;w.0efwRRJJJP\\ݻw#++ qE <sAll,^{5AAA5jVaz__ҥKqu̷?3_ի/ǟ'|'شiz),]_wڵkuV|ؾ}{ki}R`cck3^۷hݺ5̙_~fy ggg|GP Bff&BCCm۶ŕ+W?-Pヒ8::ko+|Yҵ @Ν;(..Ƈ~?={ļy0fu3&Mixꩧ ԩS}͛;wb„ zmCW_hf "i)))`0EEEXr%-[zmm۶P;;;t]:x"|||z=rssѮ]`M^~eFzŗ3K,[%YYYয়~Bdd$"""/b޽ R{HNN (//G```_[ЏQt#Kj\VZs~ZjÇc׮]w,5XJ,Y,J^ٳ"m5h4prr2g]6cŊ TTTxS­._0Kt!o;;;T*t K2tP|ᇸs<==q!̛7׮]ktˠ?3z={IҡCJœ9s>Ae+f͚iӦC2x`DFFCܹ3yfEj!]vEtt4ƏWWWEjYl^xh4ǟW˭[p%  newAddHandler <*> newAddHandler -- Read commands and fire corresponding events eventLoop :: (EventSource (), EventSource ()) -> IO () eventLoop (escoin,esplay) = loop where loop = do putStr "> " hFlush stdout s <- getLine case s of "coin" -> fire escoin () -- fire corresponding events "play" -> fire esplay () "quit" -> return () _ -> putStrLn $ s ++ " - unknown command" when (s /= "quit") loop {----------------------------------------------------------------------------- Event sources ------------------------------------------------------------------------------} -- Event Sources - allows you to register event handlers -- Your GUI framework should provide something like this for you type EventSource a = (AddHandler a, a -> IO ()) addHandler :: EventSource a -> AddHandler a addHandler = fst fire :: EventSource a -> a -> IO () fire = snd {----------------------------------------------------------------------------- Program logic ------------------------------------------------------------------------------} type Money = Int -- State of the reels, consisting of three numbers from 1-4. Example: "222" type Reels = (Int,Int,Int) -- A win consist of either double or triple numbers data Win = Double | Triple -- Program logic in terms of events and behaviors. networkDescription :: (EventSource (), EventSource ()) -> MomentIO () networkDescription (escoin,esplay) = mdo -- initial random number generator initialStdGen <- liftIO $ newStdGen -- Obtain events corresponding to the coin and play commands ecoin <- fromAddHandler (addHandler escoin) eplay <- fromAddHandler (addHandler esplay) -- The state of the slot machine is captured in Behaviors. -- State: credits that the player has to play the game -- The ecoin event adds a coin to the credits -- The edoesplay event removes money -- The ewin event adds credits because the player has won (ecredits :: Event Money, bcredits :: Behavior Money) <- mapAccum 0 . fmap (\f x -> (f x,f x)) $ unions $ [ addCredit <$ ecoin , removeCredit <$ edoesplay , addWin <$> ewin ] let -- functions that change the accumulated state addCredit = (+1) removeCredit = subtract 1 addWin Double = (+5) addWin Triple = (+20) -- Event: does the player have enough money to play the game? emayplay :: Event Bool emayplay = (\credits _ -> credits > 0) <$> bcredits <@> eplay -- Event: player has enough coins and plays edoesplay :: Event () edoesplay = () <$ filterE id emayplay -- Event: event that fires when the player doesn't have enough money edenied :: Event () edenied = () <$ filterE not emayplay -- State: random number generator (eroll :: Event Reels, bstdgen :: Behavior StdGen) -- accumulate the random number generator while rolling the reels <- mapAccum initialStdGen $ roll <$> edoesplay let -- roll the reels roll :: () -> StdGen -> (Reels, StdGen) roll () gen0 = ((z1,z2,z3),gen3) where random = randomR(1,4) (z1,gen1) = random gen0 (z2,gen2) = random gen1 (z3,gen3) = random gen2 -- Event: it's a win! ewin :: Event Win ewin = fmap fromJust $ filterE isJust $ fmap checkWin eroll checkWin (z1,z2,z3) | length (nub [z1,z2,z3]) == 1 = Just Triple | length (nub [z1,z2,z3]) == 2 = Just Double | otherwise = Nothing -- ecredits <- changes bcredits reactimate $ putStrLn . showCredit <$> ecredits reactimate $ putStrLn . showRoll <$> eroll reactimate $ putStrLn . showWin <$> ewin reactimate $ putStrLn "Not enough credits!" <$ edenied showCredit money = "Credits: " ++ show money showRoll (z1,z2,z3) = "You rolled " ++ show z1 ++ show z2 ++ show z3 showWin Double = "Wow, a double!" showWin Triple = "Wowwowow! A triple! So awesome!" reactive-banana-1.2.1.0/doc/examples/Counter.hs0000644000000000000000000000514213415425603017422 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana Example: Actuate and pause an event network acting as a counter ------------------------------------------------------------------------------} import Control.Monad (when) import System.IO import Reactive.Banana import Reactive.Banana.Frameworks main :: IO () main = do displayHelpMessage sources <- (,,) <$> newAddHandler <*> newAddHandler <*> newAddHandler network <- setupNetwork sources actuate network eventLoop sources network displayHelpMessage :: IO () displayHelpMessage = mapM_ putStrLn $ "Commands are:": " + - increase counterUp event": " - - decrease counterUp event": " p - pause event network": " a - actuate event network": " q - quit the program": "": [] -- Read commands and fire corresponding events eventLoop :: (EventSource (), EventSource (),EventSource EventNetwork) -> EventNetwork -> IO () eventLoop (eplus, eminus, espause) network = loop where loop = do putStr "> " hFlush stdout hSetBuffering stdin NoBuffering s <- getChar case s of '+' -> fire eplus () '-' -> fire eminus () 'p' -> fire espause network 'a' -> actuate network 'q' -> return () _ -> putStrLn $ [s] ++ " - unknown command" when (s /= 'q') loop {----------------------------------------------------------------------------- Event sources ------------------------------------------------------------------------------} -- Event Sources - allows you to register event handlers -- Your GUI framework should provide something like this for you type EventSource a = (AddHandler a, a -> IO ()) addHandler :: EventSource a -> AddHandler a addHandler = fst fire :: EventSource a -> a -> IO () fire = snd {----------------------------------------------------------------------------- Program logic ------------------------------------------------------------------------------} -- Set up the program logic in terms of events and behaviors. setupNetwork :: (EventSource (), EventSource (), EventSource EventNetwork) -> IO EventNetwork setupNetwork (eplus, eminus, espause) = compile $ do counterUp <- fromAddHandler (addHandler eplus) counterDown <- fromAddHandler (addHandler eminus) epause <- fromAddHandler (addHandler espause) ecount <- accumE 0 $ unions [ (+1) <$ counterUp , subtract 1 <$ counterDown ] reactimate $ fmap print ecount reactimate $ fmap pause epause reactive-banana-1.2.1.0/doc/examples/Octave.hs0000644000000000000000000000500113415425603017216 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana Example: "The world's worst synthesizer" from the unofficial tutorial. ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo #-} -- allows recursive do notation -- mdo -- ... module Main where import Data.Char (toUpper) import Control.Monad (forever) import System.IO (BufferMode(..), hSetEcho, hSetBuffering, stdin) import Reactive.Banana import Reactive.Banana.Frameworks type Octave = Int data Pitch = PA | PB | PC | PD | PE | PF | PG deriving (Eq, Enum) -- Mapping between pitch and the char responsible for it. pitchChars :: [(Pitch, Char)] pitchChars = [(p, toEnum $ fromEnum 'a' + fromEnum p) | p <- [PA .. PG]] -- Reverse of pitchChars charPitches :: [(Char, Pitch)] charPitches = [(b, a) | (a, b) <- pitchChars] data Note = Note Octave Pitch instance Show Pitch where show p = case lookup p pitchChars of Nothing -> error "cannot happen" Just c -> [toUpper c] instance Show Note where show (Note o p) = show p ++ show o -- Filter and transform events at the same time. filterMapJust :: (a -> Maybe b) -> Event a -> Event b filterMapJust f = filterJust . fmap f -- Change the original octave by adding a number of octaves, taking -- care to limit the resulting octave to the 0..10 range. changeOctave :: Int -> Octave -> Octave changeOctave d = max 0 . min 10 . (d+) -- Get the octave change for the '+' and '-' chars. getOctaveChange :: Char -> Maybe Int getOctaveChange c = case c of '+' -> Just 1 '-' -> Just (-1) _ -> Nothing makeNetworkDescription :: AddHandler Char -> MomentIO () makeNetworkDescription addKeyEvent = do eKey <- fromAddHandler addKeyEvent let eOctaveChange = filterMapJust getOctaveChange eKey bOctave <- accumB 3 (changeOctave <$> eOctaveChange) let ePitch = filterMapJust (`lookup` charPitches) eKey bPitch <- stepper PC ePitch let bNote = Note <$> bOctave <*> bPitch foo = Note 0 PA eNoteChanged <- changes bNote reactimate' $ fmap (\n -> putStrLn ("Now playing " ++ show n)) <$> eNoteChanged main :: IO () main = do (addKeyEvent, fireKey) <- newAddHandler network <- compile (makeNetworkDescription addKeyEvent) actuate network hSetEcho stdin False hSetBuffering stdin NoBuffering forever (getChar >>= fireKey) reactive-banana-1.2.1.0/doc/examples/ActuatePause.hs0000644000000000000000000000470213415425603020370 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana Example: Actuate and pause an event network ------------------------------------------------------------------------------} import Control.Monad (when) import Data.Maybe (isJust, fromJust) import Data.List (nub) import System.Random import System.IO import Debug.Trace import Data.IORef import Reactive.Banana import Reactive.Banana.Frameworks main :: IO () main = do displayHelpMessage sources <- (,) <$> newAddHandler <*> newAddHandler network <- setupNetwork sources actuate network eventLoop sources network displayHelpMessage :: IO () displayHelpMessage = mapM_ putStrLn $ "Commands are:": " count - send counter event": " pause - pause event network": " actuate - actuate event network": " quit - quit the program": "": [] -- Read commands and fire corresponding events eventLoop :: (EventSource (),EventSource EventNetwork) -> EventNetwork -> IO () eventLoop (escounter, espause) network = loop where loop = do putStr "> " hFlush stdout s <- getLine case s of "count" -> fire escounter () "pause" -> fire espause network "actuate" -> actuate network "quit" -> return () _ -> putStrLn $ s ++ " - unknown command" when (s /= "quit") loop {----------------------------------------------------------------------------- Event sources ------------------------------------------------------------------------------} -- Event Sources - allows you to register event handlers -- Your GUI framework should provide something like this for you type EventSource a = (AddHandler a, a -> IO ()) addHandler :: EventSource a -> AddHandler a addHandler = fst fire :: EventSource a -> a -> IO () fire = snd {----------------------------------------------------------------------------- Program logic ------------------------------------------------------------------------------} -- Set up the program logic in terms of events and behaviors. setupNetwork :: (EventSource (),EventSource EventNetwork) -> IO EventNetwork setupNetwork (escounter, espause) = compile $ do ecounter <- fromAddHandler (addHandler escounter) epause <- fromAddHandler (addHandler espause ) ecount <- accumE 0 $ (+1) <$ ecounter reactimate $ fmap print ecount reactimate $ fmap pause epause reactive-banana-1.2.1.0/src/0000755000000000000000000000000013415425603013651 5ustar0000000000000000reactive-banana-1.2.1.0/src/Control/0000755000000000000000000000000013415425603015271 5ustar0000000000000000reactive-banana-1.2.1.0/src/Control/Event/0000755000000000000000000000000013415425603016352 5ustar0000000000000000reactive-banana-1.2.1.0/src/Control/Event/Handler.hs0000644000000000000000000000525013415425603020265 0ustar0000000000000000module Control.Event.Handler ( -- * Synopsis -- | -- in the traditional imperative style. -- * Documentation Handler, AddHandler(..), newAddHandler, mapIO, filterIO, ) where import Data.IORef import qualified Data.Map as Map import qualified Data.Unique type Map = Map.Map {----------------------------------------------------------------------------- Types ------------------------------------------------------------------------------} -- | An /event handler/ is a function that takes an -- /event value/ and performs some computation. type Handler a = a -> IO () -- | The type 'AddHandler' represents a facility for registering -- event handlers. These will be called whenever the event occurs. -- -- When registering an event handler, you will also be given an action -- that unregisters this handler again. -- -- > do unregisterMyHandler <- register addHandler myHandler -- newtype AddHandler a = AddHandler { register :: Handler a -> IO (IO ()) } {----------------------------------------------------------------------------- Combinators ------------------------------------------------------------------------------} instance Functor AddHandler where fmap f = mapIO (return . f) -- | Map the event value with an 'IO' action. mapIO :: (a -> IO b) -> AddHandler a -> AddHandler b mapIO f e = AddHandler $ \h -> register e $ \x -> f x >>= h -- | Filter event values that don't return 'True'. filterIO :: (a -> IO Bool) -> AddHandler a -> AddHandler a filterIO f e = AddHandler $ \h -> register e $ \x -> f x >>= \b -> if b then h x else return () {----------------------------------------------------------------------------- Construction ------------------------------------------------------------------------------} -- | Build a facility to register and unregister event handlers. -- Also yields a function that takes an event handler and runs all the registered -- handlers. -- -- Example: -- -- > do -- > (addHandler, fire) <- newAddHandler -- > register addHandler putStrLn -- > fire "Hello!" newAddHandler :: IO (AddHandler a, Handler a) newAddHandler = do handlers <- newIORef Map.empty let register handler = do key <- Data.Unique.newUnique atomicModifyIORef_ handlers $ Map.insert key handler return $ atomicModifyIORef_ handlers $ Map.delete key runHandlers a = mapM_ ($ a) . map snd . Map.toList =<< readIORef handlers return (AddHandler register, runHandlers) atomicModifyIORef_ :: IORef a -> (a -> a) -> IO () atomicModifyIORef_ ref f = atomicModifyIORef ref $ \x -> (f x, ()) reactive-banana-1.2.1.0/src/Control/Monad/0000755000000000000000000000000013415425603016327 5ustar0000000000000000reactive-banana-1.2.1.0/src/Control/Monad/Trans/0000755000000000000000000000000013415425603017416 5ustar0000000000000000reactive-banana-1.2.1.0/src/Control/Monad/Trans/ReaderWriterIO.hs0000644000000000000000000000726513415425603022613 0ustar0000000000000000{-# LANGUAGE TypeFamilies #-} module Control.Monad.Trans.ReaderWriterIO ( -- * Synopsis -- | An implementation of the reader/writer monad transformer -- using an 'IORef' for the writer. -- * Documentation ReaderWriterIOT, readerWriterIOT, runReaderWriterIOT, tell, listen, ask, local, ) where import Control.Applicative import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Trans.Class import Data.IORef import Data.Monoid import Data.Semigroup {----------------------------------------------------------------------------- Type and class instances ------------------------------------------------------------------------------} newtype ReaderWriterIOT r w m a = ReaderWriterIOT { run :: r -> IORef w -> m a } instance Functor m => Functor (ReaderWriterIOT r w m) where fmap = fmapR instance Applicative m => Applicative (ReaderWriterIOT r w m) where pure = pureR (<*>) = apR instance Monad m => Monad (ReaderWriterIOT r w m) where return = returnR (>>=) = bindR instance MonadFix m => MonadFix (ReaderWriterIOT r w m) where mfix = mfixR instance MonadIO m => MonadIO (ReaderWriterIOT r w m) where liftIO = liftIOR instance MonadTrans (ReaderWriterIOT r w) where lift = liftR instance (Monad m, a ~ ()) => Semigroup (ReaderWriterIOT r w m a) where mx <> my = mx >> my instance (Monad m, a ~ ()) => Monoid (ReaderWriterIOT r w m a) where mempty = return () mx `mappend` my = mx >> my {----------------------------------------------------------------------------- Functions ------------------------------------------------------------------------------} liftIOR :: MonadIO m => IO a -> ReaderWriterIOT r w m a liftIOR m = ReaderWriterIOT $ \x y -> liftIO m liftR :: m a -> ReaderWriterIOT r w m a liftR m = ReaderWriterIOT $ \x y -> m fmapR :: Functor m => (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b fmapR f m = ReaderWriterIOT $ \x y -> fmap f (run m x y) returnR :: Monad m => a -> ReaderWriterIOT r w m a returnR a = ReaderWriterIOT $ \_ _ -> return a bindR :: Monad m => ReaderWriterIOT r w m a -> (a -> ReaderWriterIOT r w m b) -> ReaderWriterIOT r w m b bindR m k = ReaderWriterIOT $ \x y -> run m x y >>= \a -> run (k a) x y mfixR :: MonadFix m => (a -> ReaderWriterIOT r w m a) -> ReaderWriterIOT r w m a mfixR f = ReaderWriterIOT $ \x y -> mfix (\a -> run (f a) x y) pureR :: Applicative m => a -> ReaderWriterIOT r w m a pureR a = ReaderWriterIOT $ \_ _ -> pure a apR :: Applicative m => ReaderWriterIOT r w m (a -> b) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m b apR f a = ReaderWriterIOT $ \x y -> run f x y <*> run a x y readerWriterIOT :: (MonadIO m, Monoid w) => (r -> IO (a, w)) -> ReaderWriterIOT r w m a readerWriterIOT f = do r <- ask (a,w) <- liftIOR $ f r tell w return a runReaderWriterIOT :: (MonadIO m, Monoid w) => ReaderWriterIOT r w m a -> r -> m (a,w) runReaderWriterIOT m r = do ref <- liftIO $ newIORef mempty a <- run m r ref w <- liftIO $ readIORef ref return (a,w) tell :: (MonadIO m, Monoid w) => w -> ReaderWriterIOT r w m () tell w = ReaderWriterIOT $ \_ ref -> liftIO $ modifyIORef ref (`mappend` w) listen :: (MonadIO m, Monoid w) => ReaderWriterIOT r w m a -> ReaderWriterIOT r w m (a, w) listen m = ReaderWriterIOT $ \r ref -> do a <- run m r ref w <- liftIO $ readIORef ref return (a,w) local :: MonadIO m => (r -> r) -> ReaderWriterIOT r w m a -> ReaderWriterIOT r w m a local f m = ReaderWriterIOT $ \r ref -> run m (f r) ref ask :: Monad m => ReaderWriterIOT r w m r ask = ReaderWriterIOT $ \r _ -> return r test :: ReaderWriterIOT String String IO () test = do c <- ask tell c reactive-banana-1.2.1.0/src/Control/Monad/Trans/RWSIO.hs0000644000000000000000000000600113415425603020652 0ustar0000000000000000module Control.Monad.Trans.RWSIO ( -- * Synopsis -- | An implementation of the reader/writer/state monad transformer -- using an 'IORef'. -- * Documentation RWSIOT(..), Tuple(..), rwsT, runRWSIOT, tell, ask, get, put, ) where import Control.Applicative import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Trans.Class import Data.IORef import Data.Monoid {----------------------------------------------------------------------------- Type and class instances ------------------------------------------------------------------------------} data Tuple r w s = Tuple !r !(IORef w) !(IORef s) newtype RWSIOT r w s m a = R { run :: Tuple r w s -> m a } instance Functor m => Functor (RWSIOT r w s m) where fmap = fmapR instance Applicative m => Applicative (RWSIOT r w s m) where pure = pureR (<*>) = apR instance Monad m => Monad (RWSIOT r w s m) where return = returnR (>>=) = bindR instance MonadFix m => MonadFix (RWSIOT r w s m) where mfix = mfixR instance MonadIO m => MonadIO (RWSIOT r w s m) where liftIO = liftIOR instance MonadTrans (RWSIOT r w s) where lift = liftR {----------------------------------------------------------------------------- Functions ------------------------------------------------------------------------------} liftIOR :: MonadIO m => IO a -> RWSIOT r w s m a liftIOR m = R $ \_ -> liftIO m liftR :: m a -> RWSIOT r w s m a liftR m = R $ \_ -> m fmapR :: Functor m => (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b fmapR f m = R $ \x -> fmap f (run m x) returnR :: Monad m => a -> RWSIOT r w s m a returnR a = R $ \_ -> return a bindR :: Monad m => RWSIOT r w s m a -> (a -> RWSIOT r w s m b) -> RWSIOT r w s m b bindR m k = R $ \x -> run m x >>= \a -> run (k a) x mfixR :: MonadFix m => (a -> RWSIOT r w s m a) -> RWSIOT r w s m a mfixR f = R $ \x -> mfix (\a -> run (f a) x) pureR :: Applicative m => a -> RWSIOT r w s m a pureR a = R $ \_ -> pure a apR :: Applicative m => RWSIOT r w s m (a -> b) -> RWSIOT r w s m a -> RWSIOT r w s m b apR f a = R $ \x -> run f x <*> run a x rwsT :: (MonadIO m, Monoid w) => (r -> s -> IO (a, s, w)) -> RWSIOT r w s m a rwsT f = do r <- ask s <- get (a,s,w) <- liftIOR $ f r s put s tell w return a runRWSIOT :: (MonadIO m, Monoid w) => RWSIOT r w s m a -> (r -> s -> m (a,s,w)) runRWSIOT m r s = do w' <- liftIO $ newIORef mempty s' <- liftIO $ newIORef s a <- run m (Tuple r w' s') s <- liftIO $ readIORef s' w <- liftIO $ readIORef w' return (a,s,w) tell :: (MonadIO m, Monoid w) => w -> RWSIOT r w s m () tell w = R $ \(Tuple _ w' _) -> liftIO $ modifyIORef w' (`mappend` w) ask :: Monad m => RWSIOT r w s m r ask = R $ \(Tuple r _ _) -> return r get :: MonadIO m => RWSIOT r w s m s get = R $ \(Tuple _ _ s') -> liftIO $ readIORef s' put :: MonadIO m => s -> RWSIOT r w s m () put s = R $ \(Tuple _ _ s') -> liftIO $ writeIORef s' s test :: RWSIOT String String () IO () test = do c <- ask tell c reactive-banana-1.2.1.0/src/Reactive/0000755000000000000000000000000013415425603015413 5ustar0000000000000000reactive-banana-1.2.1.0/src/Reactive/Banana.hs0000644000000000000000000000272713415425603017137 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} module Reactive.Banana ( -- * Synopsis -- | Reactive-banana is a library for functional reactive programming (FRP). -- To use it, import this module: -- -- > import Reactive.Banana -- * Overview -- $intro -- * Exports module Reactive.Banana.Combinators, compile, ) where import Reactive.Banana.Combinators import Reactive.Banana.Frameworks import Reactive.Banana.Types {-$intro The module "Reactive.Banana.Combinators" collects the key types and concepts of FRP. You will spend most of your time with this module. The module "Reactive.Banana.Model" is /not/ used in practice. It contains an easy-to-understand model re-implementation of the FRP API. This is useful for learning FRP and for internal testing purposes. The module "Reactive.Banana.Frameworks" allows you to connect the FRP types and combinators to the outside world (IO). If you are /using/ an existing binding like reactive-banana-wx, then you probably won't need this module very often. On the other hand, if you are /writing/ a binding to an external library, then you will definitely need this. The module hierarchy at "Reactive.Banana.Prim" implements the efficient low-level FRP engine that powers the rest of the library. This is only useful if you want to implement your own FRP library. -}reactive-banana-1.2.1.0/src/Reactive/Banana/0000755000000000000000000000000013415425603016573 5ustar0000000000000000reactive-banana-1.2.1.0/src/Reactive/Banana/Types.hs0000644000000000000000000001403413415425603020235 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} module Reactive.Banana.Types ( -- | Primitive types. Event(..), Behavior(..), Moment(..), MomentIO(..), MonadMoment(..), Future(..), ) where import Data.Semigroup import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Control.Monad.Fix import Data.String (IsString(..)) import qualified Reactive.Banana.Internal.Combinators as Prim {----------------------------------------------------------------------------- Types ------------------------------------------------------------------------------} {-| @Event a@ represents a stream of events as they occur in time. Semantically, you can think of @Event a@ as an infinite list of values that are tagged with their corresponding time of occurrence, > type Event a = [(Time,a)] Each pair is called an /event occurrence/. Note that within a single event stream, no two event occurrences may happen at the same time. <> -} newtype Event a = E { unE :: Prim.Event a } -- Invariant: The empty list `[]` never occurs as event value. -- | The function 'fmap' applies a function @f@ to every value. -- Semantically, -- -- > fmap :: (a -> b) -> Event a -> Event b -- > fmap f e = [(time, f a) | (time, a) <- e] instance Functor Event where fmap f = E . Prim.mapE f . unE -- | The combinator '<>' merges two event streams of the same type. -- In case of simultaneous occurrences, -- the events are combined with the underlying 'Semigroup' operation. -- Semantically, -- -- > (<>) :: Event a -> Event a -> Event a -- > (<>) ex ey = unionWith (<>) ex ey instance Semigroup a => Semigroup (Event a) where x <> y = E $ Prim.unionWith (<>) (unE x) (unE y) -- | The combinator 'mempty' represents an event that never occurs. -- It is a synonym, -- -- > mempty :: Event a -- > mempty = never instance Semigroup a => Monoid (Event a) where mempty = E $ Prim.never mappend = (<>) {-| @Behavior a@ represents a value that varies in time. Semantically, you can think of it as a function > type Behavior a = Time -> a <> -} newtype Behavior a = B { unB :: Prim.Behavior a } -- | The function 'pure' returns a value that is constant in time. Semantically, -- -- > pure :: a -> Behavior a -- > pure x = \time -> x -- -- The combinator '<*>' applies a time-varying function to a time-varying value. -- -- > (<*>) :: Behavior (a -> b) -> Behavior a -> Behavior b -- > fx <*> bx = \time -> fx time $ bx time instance Applicative Behavior where pure x = B $ Prim.pureB x bf <*> bx = B $ Prim.applyB (unB bf) (unB bx) -- | The function 'fmap' applies a function @f@ at every point in time. -- Semantically, -- -- > fmap :: (a -> b) -> Behavior a -> Behavior b -- > fmap f b = \time -> f (b time) instance Functor Behavior where fmap = liftA instance Num a => Num (Behavior a) where (+) = liftA2 (+) (-) = liftA2 (-) (*) = liftA2 (*) abs = fmap abs signum = fmap signum fromInteger = pure . fromInteger negate = fmap negate instance Fractional a => Fractional (Behavior a) where (/) = liftA2 (/) fromRational = pure . fromRational recip = fmap recip instance Floating a => Floating (Behavior a) where (**) = liftA2 (**) acos = fmap acos acosh = fmap acosh asin = fmap asin asinh = fmap asinh atan = fmap atan atanh = fmap atanh cos = fmap cos cosh = fmap cosh exp = fmap exp log = fmap log logBase = liftA2 logBase pi = pure pi sin = fmap sin sinh = fmap sinh sqrt = fmap sqrt instance IsString a => IsString (Behavior a) where fromString = pure . fromString -- | The 'Future' monad is just a helper type for the 'changes' function. -- -- A value of type @Future a@ is only available in the context -- of a 'reactimate' but not during event processing. newtype Future a = F { unF :: Prim.Future a } -- boilerplate class instances instance Functor Future where fmap f = F . fmap f . unF instance Monad Future where return = F . return m >>= g = F $ unF m >>= unF . g instance Applicative Future where pure = F . pure f <*> a = F $ unF f <*> unF a {-| The 'Moment' monad denotes a /pure/ computation that happens at one particular moment in time. Semantically, it is a reader monad > type Moment a = Time -> a When run, the argument tells the time at which this computation happens. Note that in this context, /time/ really means to /logical time/. Of course, every calculation on a computer takes some amount of wall-clock time to complete. Instead, what is meant here is the time as it relates to 'Event's and 'Behavior's. We use the fiction that every calculation within the 'Moment' monad takes zero /logical time/ to perform. -} newtype Moment a = M { unM :: Prim.Moment a } {-| The 'MomentIO' monad is used to add inputs and outputs to an event network. -} newtype MomentIO a = MIO { unMIO :: Prim.Moment a } instance MonadIO MomentIO where liftIO = MIO . liftIO {-| An instance of the 'MonadMoment' class denotes a computation that happens at one particular moment in time. Unlike the 'Moment' monad, it need not be pure anymore. -} class MonadFix m => MonadMoment m where liftMoment :: Moment a -> m a instance MonadMoment Moment where liftMoment = id instance MonadMoment MomentIO where liftMoment = MIO . unM -- boilerplate class instances instance Functor Moment where fmap f = M . fmap f . unM instance Monad Moment where return = M . return m >>= g = M $ unM m >>= unM . g instance Applicative Moment where pure = M . pure f <*> a = M $ unM f <*> unM a instance MonadFix Moment where mfix f = M $ mfix (unM . f) instance Functor MomentIO where fmap f = MIO . fmap f . unMIO instance Monad MomentIO where return = MIO . return m >>= g = MIO $ unMIO m >>= unMIO . g instance Applicative MomentIO where pure = MIO . pure f <*> a = MIO $ unMIO f <*> unMIO a instance MonadFix MomentIO where mfix f = MIO $ mfix (unMIO . f) reactive-banana-1.2.1.0/src/Reactive/Banana/Combinators.hs0000644000000000000000000003161613415425603021416 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE MultiParamTypeClasses #-} module Reactive.Banana.Combinators ( -- * Synopsis -- $synopsis -- * Core Combinators -- ** Event and Behavior Event, Behavior, interpret, -- ** First-order -- | This subsections lists the primitive first-order combinators for FRP. -- The 'Functor', 'Applicative' and 'Monoid' instances are also part of this, -- but they are documented at the types 'Event' and 'Behavior'. module Control.Applicative, module Data.Semigroup, never, unionWith, filterE, apply, -- ** Moment and accumulation Moment, MonadMoment(..), accumE, stepper, -- ** Recursion -- $recursion -- ** Higher-order valueB, valueBLater, observeE, switchE, switchB, -- * Derived Combinators -- ** Infix operators (<@>), (<@), -- ** Filtering filterJust, filterApply, whenE, split, -- ** Accumulation -- $Accumulation. unions, accumB, mapAccum, ) where import Control.Applicative import Control.Monad import Data.Maybe (isJust, catMaybes) import Data.Semigroup import qualified Reactive.Banana.Internal.Combinators as Prim import Reactive.Banana.Types {----------------------------------------------------------------------------- Introduction ------------------------------------------------------------------------------} {-$synopsis The main types and combinators of Functional Reactive Programming (FRP). At its core, FRP is about two data types 'Event' and 'Behavior' and the various ways to combine them. There is also a third type 'Moment', which is necessary for the higher-order combinators. -} -- Event -- Behavior {----------------------------------------------------------------------------- Interpetation ------------------------------------------------------------------------------} -- | Interpret an event processing function. -- Useful for testing. -- -- Note: You can safely assume that this function is pure, -- even though the type seems to suggest otherwise. -- I'm really sorry about the extra 'IO', but it can't be helped. -- See source code for the sordid details. interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b] interpret f xs = Prim.interpret (fmap unE . unM . f . E) xs -- FIXME: I would love to remove the 'IO' from the type signature, -- but unfortunately, it is possible that the argument to interpret -- returns an Event that was created in the context of an existing network, e.g. -- -- > eBad <- fromAddHandler ... -- > ... -- > let ys = interpret (\_ -> return eBad ) xs -- -- Doing this is a big no-no and will break a lot of things, -- but if we remove the 'IO' here, then we will also break referential -- transparency, and I think that takes it too far. {----------------------------------------------------------------------------- Core combinators ------------------------------------------------------------------------------} -- | Event that never occurs. -- Semantically, -- -- > never = [] never :: Event a never = E Prim.never -- | Merge two event streams of the same type. -- The function argument specifies how event values are to be combined -- in case of a simultaneous occurrence. The semantics are -- -- > unionWith f ((timex,x):xs) ((timey,y):ys) -- > | timex < timey = (timex,x) : unionWith f xs ((timey,y):ys) -- > | timex > timey = (timey,y) : unionWith f ((timex,x):xs) ys -- > | timex == timey = (timex,f x y) : unionWith f xs ys unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a unionWith f e1 e2 = E $ Prim.unionWith f (unE e1) (unE e2) -- | Allow all event occurrences that are 'Just' values, discard the rest. -- Variant of 'filterE'. filterJust :: Event (Maybe a) -> Event a filterJust = E . Prim.filterJust . unE -- | Allow all events that fulfill the predicate, discard the rest. -- Semantically, -- -- > filterE p es = [(time,a) | (time,a) <- es, p a] filterE :: (a -> Bool) -> Event a -> Event a filterE p = filterJust . fmap (\x -> if p x then Just x else Nothing) -- | Apply a time-varying function to a stream of events. -- Semantically, -- -- > apply bf ex = [(time, bf time x) | (time, x) <- ex] -- -- This function is generally used in its infix variant '<@>'. apply :: Behavior (a -> b) -> Event a -> Event b apply bf ex = E $ Prim.applyE (unB bf) (unE ex) -- | Construct a time-varying function from an initial value and -- a stream of new values. The result will be a step function. -- Semantically, -- -- > stepper x0 ex = \time1 -> \time2 -> -- > last (x0 : [x | (timex,x) <- ex, time1 <= timex, timex < time2]) -- -- Here is an illustration of the result Behavior at a particular time: -- -- <> -- -- Note: The smaller-than-sign in the comparison @timex < time2@ means -- that at time @time2 == timex@, the value of the Behavior will -- still be the previous value. -- In the illustration, this is indicated by the dots at the end -- of each step. -- This allows for recursive definitions. -- See the discussion below for more on recursion. stepper :: MonadMoment m => a -> Event a -> m (Behavior a) stepper a = liftMoment . M . fmap B . Prim.stepperB a . unE -- | The 'accumE' function accumulates a stream of event values, -- similar to a /strict/ left scan, 'scanl''. -- It starts with an initial value and emits a new value -- whenever an event occurrence happens. -- The new value is calculated by applying the function in the event -- to the old value. -- -- Example: -- -- > accumE "x" [(time1,(++"y")),(time2,(++"z"))] -- > = trimE [(time1,"xy"),(time2,"xyz")] -- > where -- > trimE e start = [(time,x) | (time,x) <- e, start <= time] accumE :: MonadMoment m => a -> Event (a -> a) -> m (Event a) accumE acc = liftMoment . M . fmap E . Prim.accumE acc . unE {-$recursion /Recursion/ is a very important technique in FRP that is not apparent from the type signatures. Here is a prototypical example. It shows how the 'accumE' can be expressed in terms of the 'stepper' and 'apply' functions by using recursion: > accumE a e1 = mdo > let e2 = (\a f -> f a) <$> b <@> e1 > b <- stepper a e2 > return e2 (The @mdo@ notation refers to /value recursion/ in a monad. The 'MonadFix' instance for the 'Moment' class enables this kind of recursive code.) (Strictly speaking, this also means that 'accumE' is not a primitive, because it can be expressed in terms of other combinators.) This general pattern appears very often in practice: A Behavior (here @b@) controls what value is put into an Event (here @e2@), but at the same time, the Event contributes to changes in this Behavior. Modeling this situation requires recursion. For another example, consider a vending machine that sells banana juice. The amount that the customer still has to pay for a juice is modeled by a Behavior @bAmount@. Whenever the customer inserts a coin into the machine, an Event @eCoin@ occurs, and the amount will be reduced. Whenver the amount goes below zero, an Event @eSold@ will occur, indicating the release of a bottle of fresh banana juice, and the amount to be paid will be reset to the original price. The model requires recursion, and can be expressed in code as follows: > mdo > let price = 50 :: Int > bAmount <- accumB price $ unions > [ subtract 10 <$ eCoin > , const price <$ eSold ] > let eSold = whenE ((<= 0) <$> bAmount) eCoin On one hand, the Behavior @bAmount@ controls whether the Event @eSold@ occcurs at all; the bottle of banana juice is unavailable to penniless customers. But at the same time, the Event @eSold@ will cause a reset of the Behavior @bAmount@, so both depend on each other. Recursive code like this examples works thanks to the semantics of 'stepper'. In general, /mutual recursion/ between several 'Event's and 'Behavior's is always well-defined, as long as an Event depends on itself only /via/ a Behavior, and vice versa. -} -- | Obtain the value of the 'Behavior' at a given moment in time. -- Semantically, it corresponds to -- -- > valueB b = \time -> b time -- -- Note: The value is immediately available for pattern matching. -- Unfortunately, this means that @valueB@ is unsuitable for use -- with value recursion in the 'Moment' monad. -- If you need recursion, please use 'valueBLater' instead. valueB :: MonadMoment m => Behavior a -> m a valueB = liftMoment . M . Prim.valueB . unB -- | Obtain the value of the 'Behavior' at a given moment in time. -- Semantically, it corresponds to -- -- > valueBLater b = \time -> b time -- -- Note: To allow for more recursion, the value is returned /lazily/ -- and not available for pattern matching immediately. -- It can be used safely with most combinators like 'stepper'. -- If that doesn't work for you, please use 'valueB' instead. valueBLater :: MonadMoment m => Behavior a -> m a valueBLater = liftMoment . M . Prim.initialBLater . unB -- | Observe a value at those moments in time where -- event occurrences happen. Semantically, -- -- > observeE e = [(time, m time) | (time, m) <- e] observeE :: Event (Moment a) -> Event a observeE = E . Prim.observeE . Prim.mapE unM . unE -- | Dynamically switch between 'Event'. -- Semantically, -- -- > switchE ee = \time0 -> concat [trim t1 t2 e | (t1,t2,e) <- intervals ee, time0 <= t1] -- > where -- > intervals e = [(time1, time2, x) | ((time1,x),(time2,_)) <- zip e (tail e)] -- > trim time1 time2 e = [x | (timex,x) <- e, time1 < timex, timex <= time2] switchE :: MonadMoment m => Event (Event a) -> m (Event a) switchE = liftMoment . M . fmap E . Prim.switchE . Prim.mapE (unE) . unE -- | Dynamically switch between 'Behavior'. -- Semantically, -- -- > switchB b0 eb = \time0 -> \time1 -> -- > last (b0 : [b | (timeb,b) <- eb, time0 <= timeb, timeb < time1]) time1 switchB :: MonadMoment m => Behavior a -> Event (Behavior a) -> m (Behavior a) switchB b = liftMoment . M . fmap B . Prim.switchB (unB b) . Prim.mapE (unB) . unE {----------------------------------------------------------------------------- Derived Combinators ------------------------------------------------------------------------------} infixl 4 <@>, <@ -- | Infix synonym for the 'apply' combinator. Similar to '<*>'. -- -- > infixl 4 <@> (<@>) :: Behavior (a -> b) -> Event a -> Event b (<@>) = apply -- | Tag all event occurrences with a time-varying value. Similar to '<*'. -- -- > infixl 4 <@ (<@) :: Behavior b -> Event a -> Event b f <@ g = (const <$> f) <@> g -- | Allow all events that fulfill the time-varying predicate, discard the rest. -- Generalization of 'filterE'. filterApply :: Behavior (a -> Bool) -> Event a -> Event a filterApply bp = fmap snd . filterE fst . apply ((\p a-> (p a,a)) <$> bp) -- | Allow events only when the behavior is 'True'. -- Variant of 'filterApply'. whenE :: Behavior Bool -> Event a -> Event a whenE bf = filterApply (const <$> bf) -- | Split event occurrences according to a tag. -- The 'Left' values go into the left component while the 'Right' values -- go into the right component of the result. split :: Event (Either a b) -> (Event a, Event b) split e = (filterJust $ fromLeft <$> e, filterJust $ fromRight <$> e) where fromLeft :: Either a b -> Maybe a fromLeft (Left a) = Just a fromLeft (Right b) = Nothing fromRight :: Either a b -> Maybe b fromRight (Left a) = Nothing fromRight (Right b) = Just b -- $Accumulation. -- Note: All accumulation functions are strict in the accumulated value! -- -- Note: The order of arguments is @acc -> (x,acc)@ -- which is also the convention used by 'unfoldr' and 'State'. -- | Merge event streams whose values are functions. -- In case of simultaneous occurrences, the functions at the beginning -- of the list are applied /after/ the functions at the end. -- -- > unions [] = never -- > unions xs = foldr1 (unionWith (.)) xs -- -- Very useful in conjunction with accumulation functions like 'accumB' -- and 'accumE'. unions :: [Event (a -> a)] -> Event (a -> a) unions [] = never unions xs = foldr1 (unionWith (.)) xs -- | The 'accumB' function accumulates event occurrences into a 'Behavior'. -- -- The value is accumulated using 'accumE' and converted -- into a time-varying value using 'stepper'. -- -- Example: -- -- > accumB "x" [(time1,(++"y")),(time2,(++"z"))] -- > = stepper "x" [(time1,"xy"),(time2,"xyz")] -- -- Note: As with 'stepper', the value of the behavior changes \"slightly after\" -- the events occur. This allows for recursive definitions. accumB :: MonadMoment m => a -> Event (a -> a) -> m (Behavior a) accumB acc e = stepper acc =<< accumE acc e -- | Efficient combination of 'accumE' and 'accumB'. mapAccum :: MonadMoment m => acc -> Event (acc -> (x,acc)) -> m (Event x, Behavior acc) mapAccum acc ef = do e <- accumE (undefined,acc) (lift <$> ef) b <- stepper acc (snd <$> e) return (fst <$> e, b) where lift f (_,acc) = acc `seq` f acc reactive-banana-1.2.1.0/src/Reactive/Banana/Prim.hs0000644000000000000000000000732713415425603020047 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo #-} module Reactive.Banana.Prim ( -- * Synopsis -- | This is an internal module, useful if you want to -- implemented your own FRP library. -- If you just want to use FRP in your project, -- have a look at "Reactive.Banana" instead. -- * Evaluation Step, Network, emptyNetwork, -- * Build FRP networks Build, liftIOLater, BuildIO, liftBuild, buildLater, buildLaterReadNow, compile, module Control.Monad.IO.Class, -- * Caching module Reactive.Banana.Prim.Cached, -- * Testing interpret, mapAccumM, mapAccumM_, runSpaceProfile, -- * IO newInput, addHandler, readLatch, -- * Pulse Pulse, neverP, alwaysP, mapP, Future, tagFuture, unsafeMapIOP, filterJustP, unionWithP, -- * Latch Latch, pureL, mapL, applyL, accumL, applyP, -- * Dynamic event switching switchL, executeP, switchP -- * Notes -- $recursion ) where import Control.Monad.IO.Class import Reactive.Banana.Prim.Cached import Reactive.Banana.Prim.Combinators import Reactive.Banana.Prim.Compile import Reactive.Banana.Prim.IO import Reactive.Banana.Prim.Plumbing (neverP, alwaysP, liftBuild, buildLater, buildLaterReadNow, liftIOLater) import Reactive.Banana.Prim.Types {----------------------------------------------------------------------------- Notes ------------------------------------------------------------------------------} -- Note [Recursion] {- $recursion The 'Build' monad is an instance of 'MonadFix' and supports value recursion. However, it is built on top of the 'IO' monad, so the recursion is somewhat limited. The main rule for value recursion in the 'IO' monad is that the action to be performed must be known in advance. For instance, the following snippet will not work, because 'putStrLn' cannot complete its action without inspecting @x@, which is not defined until later. > mdo > putStrLn x > let x = "Hello recursion" On the other hand, whenever the sequence of 'IO' actions can be known before inspecting any later arguments, the recursion works. For instance the snippet > mdo > p1 <- mapP p2 > p2 <- neverP > return p1 works because 'mapP' does not inspect its argument. In other words, a call @p1 <- mapP undefined@ would perform the same sequence of 'IO' actions. (Internally, it essentially calls 'newIORef'.) With this issue in mind, almost all operations that build 'Latch' and 'Pulse' values have been carefully implemented to not inspect their arguments. In conjunction with the 'Cached' mechanism for observable sharing, this allows us to build combinators that can be used recursively. One notable exception is the 'readLatch' function, which must inspect its argument in order to be able to read its value. -} test :: Build (Pulse ()) test = mdo p1 <- mapP (const ()) p2 p2 <- neverP return p1 -- Note [LatchStrictness] {- Any value that is stored in the graph over a longer period of time must be stored in WHNF. This implies that the values in a latch must be forced to WHNF when storing them. That doesn't have to be immediately since we are tying a knot, but it definitely has to be done before evaluateGraph is done. It also implies that reading a value from a latch must be forced to WHNF before storing it again, so that we don't carry around the old collection of latch values. This is particularly relevant for `applyL`. Conversely, since latches are the only way to store values over time, this is enough to guarantee that there are no space leaks in this regard. -} reactive-banana-1.2.1.0/src/Reactive/Banana/Model.hs0000644000000000000000000001356113415425603020175 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo #-} module Reactive.Banana.Model ( -- * Synopsis -- | Model implementation for learning and testing. -- * Overview -- $overview -- * Core Combinators -- ** Event and Behavior Nat, Time, Event(..), Behavior(..), interpret, -- ** First-order module Control.Applicative, never, unionWith, filterJust, apply, -- ** Moment and accumulation Moment(..), accumE, stepper, -- ** Higher-order valueB, observeE, switchE, switchB, ) where import Control.Applicative import Control.Monad import Control.Monad.Fix {-$overview This module reimplements the key FRP types and functions from the module "Reactive.Banana.Combinators" in a way that is hopefully easier to understand. Thereby, this model also specifies the semantics of the library. Of course, the real implementation is much more efficient than this model here. To understand the model in detail, look at the source code! (If there is no link to the source code at every type signature, then you have to run cabal with --hyperlink-source flag.) This model is /authoritative/: Event functions that have been constructed using the same combinators /must/ give the same results when run with the @interpret@ function from either the module "Reactive.Banana.Combinators" or the module "Reactive.Banana.Model". This must also hold for recursive and partial definitions (at least in spirit, I'm not going to split hairs over @_|_@ vs @\\_ -> _|_@). -} {----------------------------------------------------------------------------- Event and Behavior ------------------------------------------------------------------------------} -- | Natural numbers (poorly represented). type Nat = Int -- | The FRP model used in this library is actually a model with continuous time. -- -- However, it can be shown that this model is observationally -- equivalent to a particular model with (seemingly) discrete time steps, -- which is implemented here. -- The main reason for doing this is to be able to handle recursion correctly. -- Details will be explained elsewhere. type Time = Nat -- begins at t = 0 -- | Event is modeled by an /infinite/ list of 'Maybe' values. -- It is isomorphic to @Time -> Maybe a@. -- -- 'Nothing' indicates that no occurrence happens, -- while 'Just' indicates that an occurrence happens. newtype Event a = E { unE :: [Maybe a] } deriving (Show) -- | Behavior is modeled by an /infinite/ list of values. -- It is isomorphic to @Time -> a@. newtype Behavior a = B { unB :: [a] } deriving (Show) interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> [Maybe b] interpret f as = take (length as) . unE . (\m -> unM m 0) . f . E $ (as ++ repeat Nothing) {----------------------------------------------------------------------------- First-order ------------------------------------------------------------------------------} instance Functor Event where fmap f (E xs) = E (fmap (fmap f) xs) instance Functor Behavior where fmap f (B xs) = B (fmap f xs) instance Applicative Behavior where pure x = B $ repeat x (B f) <*> (B x) = B $ zipWith ($) f x never :: Event a never = E $ repeat Nothing unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a unionWith f (E xs) (E ys) = E $ zipWith combine xs ys where combine (Just x) (Just y) = Just $ f x y combine (Just x) Nothing = Just x combine Nothing (Just y) = Just y combine Nothing Nothing = Nothing filterJust :: Event (Maybe a) -> Event a filterJust = E . fmap join . unE apply :: Behavior (a -> b) -> Event a -> Event b apply (B fs) = E . zipWith (\f mx -> fmap f mx) fs . unE {----------------------------------------------------------------------------- Moment and accumulation ------------------------------------------------------------------------------} newtype Moment a = M { unM :: Time -> a } instance Functor Moment where fmap f = M . fmap f . unM instance Applicative Moment where pure = M . const (<*>) = ap instance Monad Moment where return = pure (M m) >>= k = M $ \time -> unM (k $ m time) time instance MonadFix Moment where mfix f = M $ mfix (unM . f) -- Forget all event occurences before a particular time forgetE :: Time -> Event a -> [Maybe a] forgetE time (E xs) = drop time xs stepper :: a -> Event a -> Moment (Behavior a) stepper i e = M $ \time -> B $ replicate time i ++ step i (forgetE time e) where step i ~(x:xs) = i : step next xs where next = case x of Just i -> i Nothing -> i -- Expressed using recursion and the other primitives -- FIXME: Strictness! accumE :: a -> Event (a -> a) -> Moment (Event a) accumE a e1 = mdo let e2 = ((\a f -> f a) <$> b) `apply` e1 b <- stepper a e2 return e2 {----------------------------------------------------------------------------- Higher-order ------------------------------------------------------------------------------} valueB :: Behavior a -> Moment a valueB (B b) = M $ \time -> b !! time observeE :: Event (Moment a) -> Event a observeE = E . zipWith (\time -> fmap (\m -> unM m time)) [0..] . unE switchE :: Event (Event a) -> Moment (Event a) switchE es = M $ \t -> E $ replicate t Nothing ++ switch (unE never) (forgetE t (forgetDiagonalE es)) where switch (x:xs) (Nothing : ys) = x : switch xs ys switch (x: _) (Just xs : ys) = x : switch (tail xs) ys forgetDiagonalE :: Event (Event a) -> Event [Maybe a] forgetDiagonalE = E . zipWith (\time -> fmap (forgetE time)) [0..] . unE switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a) switchB b e = diagonalB <$> stepper b e diagonalB :: Behavior (Behavior a) -> Behavior a diagonalB = B . zipWith (\time xs -> xs !! time) [0..] . map unB . unB reactive-banana-1.2.1.0/src/Reactive/Banana/Test.hs0000644000000000000000000001754513415425603020062 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana Test cases and examples ------------------------------------------------------------------------------} {-# LANGUAGE Rank2Types, NoMonomorphismRestriction, RecursiveDo #-} import Control.Arrow import Control.Monad (when, join) import Test.Framework (defaultMain, testGroup, Test) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit (assert, Assertion) -- import Test.QuickCheck -- import Test.QuickCheck.Property import Control.Applicative import Reactive.Banana.Test.Plumbing main = defaultMain [ testGroup "Simple" [ testModelMatch "id" id , testModelMatch "never1" never1 , testModelMatch "fmap1" fmap1 , testModelMatch "filter1" filter1 , testModelMatch "filter2" filter2 , testModelMatchM "accumE1" accumE1 ] , testGroup "Complex" [ testModelMatchM "counter" counter , testModelMatch "double" double , testModelMatch "sharing" sharing , testModelMatch "unionFilter" unionFilter , testModelMatchM "recursive1A" recursive1A , testModelMatchM "recursive1B" recursive1B , testModelMatchM "recursive2" recursive2 , testModelMatchM "recursive3" recursive3 , testModelMatchM "recursive4a" recursive4a -- , testModelMatchM "recursive4b" recursive4b , testModelMatchM "accumBvsE" accumBvsE ] , testGroup "Dynamic Event Switching" [ testModelMatch "observeE_id" observeE_id , testModelMatch "observeE_stepper" observeE_stepper , testModelMatchM "valueB_immediate" valueB_immediate -- , testModelMatchM "valueB_recursive1" valueB_recursive1 -- , testModelMatchM "valueB_recursive2" valueB_recursive2 , testModelMatchM "dynamic_apply" dynamic_apply , testModelMatchM "switchE1" switchE1 , testModelMatchM "switchB1" switchB1 , testModelMatchM "switchB2" switchB2 ] , testGroup "Regression tests" [ testModelMatchM "issue79" issue79 ] -- TODO: -- * algebraic laws -- * larger examples -- * quickcheck ] {----------------------------------------------------------------------------- Testing ------------------------------------------------------------------------------} matchesModel :: (Show b, Eq b) => (Event a -> Moment (Event b)) -> [a] -> IO Bool matchesModel f xs = do bs1 <- return $ interpretModel f (singletons xs) bs2 <- interpretGraph f (singletons xs) -- bs3 <- interpretFrameworks f xs let bs = [bs1,bs2] let b = all (==bs1) bs when (not b) $ mapM_ print bs return b singletons = map Just -- test whether model matches testModelMatchM :: (Show b, Eq b) => String -> (Event Int -> Moment (Event b)) -> Test testModelMatchM name f = testCase name $ assert $ matchesModel f [1..8::Int] testModelMatch name f = testModelMatchM name (return . f) -- individual tests for debugging testModel :: (Event Int -> Event b) -> [Maybe b] testModel f = interpretModel (return . f) $ singletons [1..8::Int] testGraph f = interpretGraph (return . f) $ singletons [1..8::Int] testModelM f = interpretModel f $ singletons [1..8::Int] testGraphM f = interpretGraph f $ singletons [1..8::Int] {----------------------------------------------------------------------------- Tests ------------------------------------------------------------------------------} never1 :: Event Int -> Event Int never1 = const never fmap1 = fmap (+1) filterE p = filterJust . fmap (\e -> if p e then Just e else Nothing) filter1 = filterE (>= 3) filter2 = filterE (>= 3) . fmap (subtract 1) accumE1 = accumE 0 . ((+1) <$) counter e = do bcounter <- accumB 0 $ fmap (\_ -> (+1)) e return $ applyE (pure const <*> bcounter) e merge e1 e2 = unionWith (++) (list e1) (list e2) where list = fmap (:[]) double e = merge e e sharing e = merge e1 e1 where e1 = filterE (< 3) e unionFilter e1 = unionWith (+) e2 e3 where e3 = fmap (+1) $ filterE even e1 e2 = fmap (+1) $ filterE odd e1 recursive1A e1 = mdo let e2 = applyE ((+) <$> b) e1 b <- stepperB 0 e2 return e2 recursive1B e1 = mdo b <- stepperB 0 e2 let e2 = applyE ((+) <$> b) e1 return e2 recursive2 e1 = mdo b <- fmap ((+) <$>) $ stepperB 0 e3 let e2 = applyE b e1 let e3 = applyE (id <$> b) e1 -- actually equal to e2 return e2 type Dummy = Int -- Counter that can be decreased as long as it's >= 0 . recursive3 :: Event Dummy -> Moment (Event Int) recursive3 edec = mdo bcounter <- accumB 4 $ (subtract 1) <$ ecandecrease let ecandecrease = whenE ((>0) <$> bcounter) edec return $ applyE (const <$> bcounter) ecandecrease -- Recursive 4 is an example reported by Merijn Verstraaten -- https://github.com/HeinrichApfelmus/reactive-banana/issues/56 -- Minimization: recursive4a :: Event Int -> Moment (Event (Bool, Int)) recursive4a eInput = mdo focus <- stepperB False $ fst <$> resultE let resultE = resultB <@ eInput let resultB = (,) <$> focus <*> pureB 0 return $ resultB <@ eInput {- -- Full example: recursive4b :: Event Int -> Event (Bool, Int) recursive4b eInput = result <@ eInput where focus = stepperB False $ fst <$> result <@ eInput interface = (,) <$> focus <*> cntrVal (cntrVal, focusChange) = counter eInput focus result = stepperB id ((***id) <$> focusChange) <*> interface filterApply :: Behavior (a -> Bool) -> Event a -> Event a filterApply b e = filterJust $ sat <$> b <@> e where sat p x = if p x then Just x else Nothing counter :: Event Int -> Behavior Bool -> (Behavior Int, Event (Bool -> Bool)) counter input active = (result, not <$ eq) where result = accumB 0 $ (+) <$> neq eq = filterApply ((==) <$> result) input neq = filterApply ((/=) <$> result) input -} -- Test 'accumE' vs 'accumB'. accumBvsE :: Event Dummy -> Moment (Event [Int]) accumBvsE e = mdo e1 <- accumE 0 ((+1) <$ e) b <- accumB 0 ((+1) <$ e) let e2 = applyE (const <$> b) e return $ merge e1 e2 observeE_id = observeE . fmap return -- = id observeE_stepper :: Event Int -> Event Int observeE_stepper e = observeE $ (valueB =<< mb) <$ e where mb :: Moment (Behavior Int) mb = stepper 0 e valueB_immediate e = do x <- valueB =<< stepper 0 e return $ x <$ e {-- The following tests would need to use the valueBLater combinator valueB_recursive1 e1 = mdo _ <- initialB b let b = stepper 0 e1 return $ b <@ e1 valueB_recursive2 e1 = mdo x <- initialB b let bf = const x <$ stepper 0 e1 let b = stepper 0 $ (bf <*> b) <@ e1 return $ b <@ e1 -} dynamic_apply e = do b <- stepper 0 e return $ observeE $ (valueB b) <$ e -- = stepper 0 e <@ e switchE1 e = switchE (e <$ e) switchB1 e = do b0 <- stepper 0 e b1 <- stepper 0 e b <- switchB b0 $ (\x -> if odd x then b1 else b0) <$> e return $ b <@ e switchB2 e = do b0 <- stepper 0 $ filterE even e b1 <- stepper 1 $ filterE odd e b <- switchB b0 $ (\x -> if odd x then b1 else b0) <$> e return $ b <@ e {----------------------------------------------------------------------------- Regression tests ------------------------------------------------------------------------------} issue79 :: Event Dummy -> Moment (Event String) issue79 inputEvent = mdo let appliedEvent = (\_ _ -> 1) <$> lastValue <@> inputEvent filteredEvent = filterE (const True) appliedEvent fmappedEvent = fmap id (filteredEvent) lastValue <- stepper 1 $ fmappedEvent let outputEvent = unionWith (++) (const "filtered event" <$> filteredEvent) (((" and " ++) . show) <$> unionWith (+) appliedEvent fmappedEvent) return $ outputEvent reactive-banana-1.2.1.0/src/Reactive/Banana/Frameworks.hs0000644000000000000000000003476013415425603021261 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE Rank2Types #-} module Reactive.Banana.Frameworks ( -- * Synopsis -- | Connect to the outside world by building 'EventNetwork's -- and running them. -- * Simple use interpretAsHandler, -- * Overview -- $build -- * Building event networks with input/output -- ** Core functions compile, MomentIO, module Control.Event.Handler, fromAddHandler, fromChanges, fromPoll, reactimate, Future, reactimate', changes, -- $changes imposeChanges, execute, liftIOLater, -- $liftIO module Control.Monad.IO.Class, -- ** Utility functions -- | This section collects a few convience functions -- built from the core functions. interpretFrameworks, newEvent, mapEventIO, newBehavior, -- * Running event networks EventNetwork, actuate, pause, ) where import Control.Event.Handler import Control.Monad import Control.Monad.IO.Class import Data.IORef import Reactive.Banana.Combinators import qualified Reactive.Banana.Internal.Combinators as Prim import Reactive.Banana.Types {----------------------------------------------------------------------------- Documentation ------------------------------------------------------------------------------} {-$build After having read all about 'Event's and 'Behavior's, you want to hook them up to an existing event-based framework, like @wxHaskell@ or @Gtk2Hs@. How do you do that? The module presented here allows you to * obtain /input/ events from external sources and to * perform /output/ in reaction to events. In contrast, the functions from "Reactive.Banana.Combinators" allow you to express the output events in terms of the input events. This expression is called an /event graph/. An /event network/ is an event graph together with inputs and outputs. To build an event network, describe the inputs, outputs and event graph in the 'MomentIO' monad and use the 'compile' function to obtain an event network from that. To /activate/ an event network, use the 'actuate' function. The network will register its input event handlers and start producing output. A typical setup looks like this: > main = do > -- initialize your GUI framework > window <- newWindow > ... > > -- describe the event network > let networkDescription :: MomentIO () > networkDescription = do > -- input: obtain Event from functions that register event handlers > emouse <- fromAddHandler $ registerMouseEvent window > ekeyboard <- fromAddHandler $ registerKeyEvent window > -- input: obtain Behavior from changes > btext <- fromChanges "" $ registerTextChange editBox > -- input: obtain Behavior from mutable data by polling > bdie <- fromPoll $ randomRIO (1,6) > > -- express event graph > behavior1 <- accumB ... > let > ... > event15 = union event13 event14 > > -- output: animate some event occurrences > reactimate $ fmap print event15 > reactimate $ fmap drawCircle eventCircle > > -- compile network description into a network > network <- compile networkDescription > -- register handlers and start producing outputs > actuate network In short, * Use 'fromAddHandler' to obtain /input/ events. The library uses this to register event handlers with your event-based framework. * Use 'reactimate' to animate /output/ events. * Use 'compile' to put everything together in an 'EventNetwork's and use 'actuate' to start handling events. -} {----------------------------------------------------------------------------- Combinators ------------------------------------------------------------------------------} {- | Output. Execute the 'IO' action whenever the event occurs. Note: If two events occur very close to each other, there is no guarantee that the @reactimate@s for one event will have finished before the ones for the next event start executing. This does /not/ affect the values of events and behaviors, it only means that the @reactimate@ for different events may interleave. Fortunately, this is a very rare occurrence, and only happens if * you call an event handler from inside 'reactimate', * or you use concurrency. In these cases, the @reactimate@s follow the control flow of your event-based framework. Note: An event network essentially behaves like a single, huge callback function. The 'IO' action are not run in a separate thread. The callback function will throw an exception if one of your 'IO' actions does so as well. Your event-based framework will have to handle this situation. -} reactimate :: Event (IO ()) -> MomentIO () reactimate = MIO . Prim.addReactimate . Prim.mapE return . unE -- | Output. -- Execute the 'IO' action whenever the event occurs. -- -- This version of 'reactimate' can deal with values obtained -- from the 'changes' function. reactimate' :: Event (Future (IO ())) -> MomentIO () reactimate' = MIO . Prim.addReactimate . Prim.mapE unF . unE -- | Input, -- obtain an 'Event' from an 'AddHandler'. -- -- When the event network is actuated, -- this will register a callback function such that -- an event will occur whenever the callback function is called. fromAddHandler ::AddHandler a -> MomentIO (Event a) fromAddHandler = MIO . fmap E . Prim.fromAddHandler -- | Input, -- obtain a 'Behavior' by frequently polling mutable data, like the current time. -- -- The resulting 'Behavior' will be updated on whenever the event -- network processes an input event. -- -- This function is occasionally useful, but -- the recommended way to obtain 'Behaviors' is by using 'fromChanges'. -- -- Ideally, the argument IO action just polls a mutable variable, -- it should not perform expensive computations. -- Neither should its side effects affect the event network significantly. fromPoll :: IO a -> MomentIO (Behavior a) fromPoll = MIO . fmap B . Prim.fromPoll -- | Input, -- obtain a 'Behavior' from an 'AddHandler' that notifies changes. -- -- This is essentially just an application of the 'stepper' combinator. fromChanges :: a -> AddHandler a -> MomentIO (Behavior a) fromChanges initial changes = do e <- fromAddHandler changes stepper initial e -- | Output, -- return an 'Event' that is adapted to the changes of a 'Behavior'. -- -- Remember that semantically, a 'Behavior' is a function @Behavior a = Time -> a@. -- This means that a Behavior does not have a notion of \"changes\" associated with it. -- For instance, the following Behaviors are equal: -- -- > stepper 0 [] -- > = stepper 0 [(time1, 0), (time2, 0)] -- > = stepper 0 $ zip [time1,time2..] (repeat 0) -- -- In principle, to perform IO actions with the value of a Behavior, -- one has to sample it using an 'Event' and the 'apply' function. -- -- However, in practice, Behaviors are usually step functions. -- For reasons of efficiency, the library provides a way -- to obtain an Event that /mostly/ coincides with the steps of a Behavior, -- so that sampling is only done at a few select points in time. -- The idea is that -- -- > changes =<< stepper x e = return e -- -- Please use 'changes' only in a ways that do /not/ distinguish -- between the different expressions for the same Behavior above. -- -- Note that the value of the event is actually the /new/ value, -- i.e. that value slightly after this point in time. (See the documentation of 'stepper'). -- This is more convenient. -- However, the value will not become available until after event processing is complete; -- this is indicated by the type 'Future'. -- It can be used only in the context of 'reactimate''. changes :: Behavior a -> MomentIO (Event (Future a)) changes = return . E . Prim.mapE F . Prim.changesB . unB {- $changes Note: If you need a variant of the 'changes' function that does /not/ have the additional 'Future' type, then the following code snippet may be useful: > plainChanges :: Behavior a -> MomentIO (Event a) > plainChanges b = do > (e, handle) <- newEvent > eb <- changes b > reactimate' $ (fmap handle) <$> eb > return e However, this approach is not recommended, because the result 'Event' will occur /slightly/ later than the event returned by 'changes'. In fact, there is no guarantee whatsoever about what /slightly/ means in this context. Still, it is useful in some cases. -} -- | Impose a different sampling event on a 'Behavior'. -- -- The 'Behavior' will have the same values as before, but the event returned -- by the 'changes' function will now happen simultaneously with the -- imposed event. -- -- Note: This function is useful only in very specific circumstances. imposeChanges :: Behavior a -> Event () -> Behavior a imposeChanges b e = B $ Prim.imposeChanges (unB b) (Prim.mapE (const ()) (unE e)) {- | Dynamically add input and output to an existing event network. Note: You can perform 'IO' actions here, which is useful if you want to register additional event handlers dynamically. However, if two arguments to 'execute' occur simultaneously, then the order in which the 'IO' therein are executed is unspecified. For instance, in the following code > example e = do > e1 <- execute (liftIO (putStrLn "A") <$ e) > e2 <- execute (liftIO (putStrLn "B") <$ e) > return (e1,e2) it is unspecified whether @A@ or @B@ are printed first. Moreover, if the result 'Event' of this function has been garbage collected, it may also happen that the actions are not executed at all. In the example above, if the events `e1` and `e2` are not used any further, then it can be that neither @A@ nor @B@ will be printed. If your main goal is to reliably turn events into 'IO' actions, use the 'reactimate' and 'reactimate'' functions instead. -} execute :: Event (MomentIO a) -> MomentIO (Event a) execute = MIO . fmap E . Prim.executeE . Prim.mapE unMIO . unE -- $liftIO -- -- > liftIO :: Frameworks t => IO a -> Moment t a -- -- Lift an 'IO' action into the 'Moment' monad. -- | Lift an 'IO' action into the 'Moment' monad, -- but defer its execution until compilation time. -- This can be useful for recursive definitions using 'MonadFix'. liftIOLater :: IO () -> MomentIO () liftIOLater = MIO . Prim.liftIOLater -- | Compile the description of an event network -- into an 'EventNetwork' -- that you can 'actuate', 'pause' and so on. compile :: MomentIO () -> IO EventNetwork compile = fmap EN . Prim.compile . unMIO {----------------------------------------------------------------------------- Running event networks ------------------------------------------------------------------------------} -- | Data type that represents a compiled event network. -- It may be paused or already running. newtype EventNetwork = EN { unEN :: Prim.EventNetwork } -- | Actuate an event network. -- The inputs will register their event handlers, so that -- the networks starts to produce outputs in response to input events. actuate :: EventNetwork -> IO () actuate = Prim.actuate . unEN -- | Pause an event network. -- Immediately stop producing output. -- (In a future version, it will also unregister all event handlers for inputs.) -- Hence, the network stops responding to input events, -- but it's state will be preserved. -- -- You can resume the network with 'actuate'. -- -- Note: You can stop a network even while it is processing events, -- i.e. you can use 'pause' as an argument to 'reactimate'. -- The network will /not/ stop immediately though, only after -- the current event has been processed completely. pause :: EventNetwork -> IO () pause = Prim.pause . unEN {----------------------------------------------------------------------------- Utilities ------------------------------------------------------------------------------} -- | Build an 'Event' together with an 'IO' action that can -- fire occurrences of this event. Variant of 'newAddHandler'. -- -- This function is mainly useful for passing callback functions -- inside a 'reactimate'. newEvent :: MomentIO (Event a, Handler a) newEvent = do (addHandler, fire) <- liftIO $ newAddHandler e <- fromAddHandler addHandler return (e,fire) -- | Build a 'Behavior' together with an 'IO' action that can -- update this behavior with new values. -- -- Implementation: -- -- > newBehavior a = do -- > (e, fire) <- newEvent -- > b <- stepper a e -- > return (b, fire) newBehavior :: a -> MomentIO (Behavior a, Handler a) newBehavior a = do (e, fire) <- newEvent b <- stepper a e return (b, fire) -- | Build a new 'Event' that contains the result -- of an IO computation. -- The input and result events will /not/ be simultaneous anymore, -- the latter will occur /later/ than the former. -- -- Please use the 'fmap' for 'Event' if your computation is pure. -- -- Implementation: -- -- > mapEventIO f e1 = do -- > (e2, handler) <- newEvent -- > reactimate $ (\a -> f a >>= handler) <$> e1 -- > return e2 mapEventIO :: (a -> IO b) -> Event a -> MomentIO (Event b) mapEventIO f e1 = do (e2, handler) <- newEvent reactimate $ (\a -> f a >>= handler) <$> e1 return e2 {----------------------------------------------------------------------------- Simple use ------------------------------------------------------------------------------} -- | Interpret an event processing function by building an 'EventNetwork' -- and running it. Useful for testing, but uses 'MomentIO'. -- See 'interpret' for a plain variant. interpretFrameworks :: (Event a -> MomentIO (Event b)) -> [Maybe a] -> IO [Maybe b] interpretFrameworks f xs = do output <- newIORef Nothing (addHandler, runHandlers) <- newAddHandler network <- compile $ do e1 <- fromAddHandler addHandler e2 <- f e1 reactimate $ writeIORef output . Just <$> e2 actuate network bs <- forM xs $ \x -> do case x of Nothing -> return Nothing Just x -> do runHandlers x b <- readIORef output writeIORef output Nothing return b return bs -- | Simple way to write a single event handler with -- functional reactive programming. interpretAsHandler :: (Event a -> Moment (Event b)) -> AddHandler a -> AddHandler b interpretAsHandler f addHandlerA = AddHandler $ \handlerB -> do network <- compile $ do e1 <- fromAddHandler addHandlerA e2 <- liftMoment (f e1) reactimate $ handlerB <$> e2 actuate network return (pause network) reactive-banana-1.2.1.0/src/Reactive/Banana/Internal/0000755000000000000000000000000013415425603020347 5ustar0000000000000000reactive-banana-1.2.1.0/src/Reactive/Banana/Internal/Combinators.hs0000644000000000000000000002062313415425603023166 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo, FlexibleInstances, NoMonomorphismRestriction #-} module Reactive.Banana.Internal.Combinators where import Control.Concurrent.MVar import Control.Event.Handler import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader import Data.Functor import Data.Functor.Identity import Data.IORef import qualified Reactive.Banana.Prim as Prim import Reactive.Banana.Prim.Cached type Build = Prim.Build type Latch a = Prim.Latch a type Pulse a = Prim.Pulse a type Future = Prim.Future {----------------------------------------------------------------------------- Types ------------------------------------------------------------------------------} type Behavior a = Cached Moment (Latch a, Pulse ()) type Event a = Cached Moment (Pulse a) type Moment = ReaderT EventNetwork Prim.Build liftBuild :: Build a -> Moment a liftBuild = lift {----------------------------------------------------------------------------- Interpretation ------------------------------------------------------------------------------} interpret :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b] interpret f = Prim.interpret $ \pulse -> runReaderT (g pulse) undefined where g pulse = runCached =<< f (Prim.fromPure pulse) -- Ignore any addHandler inside the Moment {----------------------------------------------------------------------------- IO ------------------------------------------------------------------------------} -- | Data type representing an event network. data EventNetwork = EventNetwork { runStep :: Prim.Step -> IO () , actuate :: IO () , pause :: IO () } -- | Compile to an event network. compile :: Moment () -> IO EventNetwork compile setup = do actuated <- newIORef False -- flag to set running status s <- newEmptyMVar -- setup callback machinery let whenFlag flag action = readIORef flag >>= \b -> when b action runStep f = whenFlag actuated $ do s1 <- takeMVar s -- read and take lock -- pollValues <- sequence polls -- poll mutable data (output, s2) <- f s1 -- calculate new state putMVar s s2 -- write state output -- run IO actions afterwards eventNetwork = EventNetwork { runStep = runStep , actuate = writeIORef actuated True , pause = writeIORef actuated False } (output, s0) <- -- compile initial graph Prim.compile (runReaderT setup eventNetwork) Prim.emptyNetwork putMVar s s0 -- set initial state return $ eventNetwork fromAddHandler :: AddHandler a -> Moment (Event a) fromAddHandler addHandler = do (p, fire) <- liftBuild $ Prim.newInput network <- ask liftIO $ register addHandler $ runStep network . fire return $ Prim.fromPure p addReactimate :: Event (Future (IO ())) -> Moment () addReactimate e = do network <- ask liftBuild $ Prim.buildLater $ do -- Run cached computation later to allow more recursion with `Moment` p <- runReaderT (runCached e) network Prim.addHandler p id fromPoll :: IO a -> Moment (Behavior a) fromPoll poll = do a <- liftIO poll e <- liftBuild $ do p <- Prim.unsafeMapIOP (const poll) =<< Prim.alwaysP return $ Prim.fromPure p stepperB a e liftIONow :: IO a -> Moment a liftIONow = liftIO liftIOLater :: IO () -> Moment () liftIOLater = lift . Prim.liftBuild . Prim.liftIOLater imposeChanges :: Behavior a -> Event () -> Behavior a imposeChanges = liftCached2 $ \(l1,_) p2 -> return (l1,p2) {----------------------------------------------------------------------------- Combinators - basic ------------------------------------------------------------------------------} never :: Event a never = don'tCache $ liftBuild $ Prim.neverP unionWith :: (a -> a -> a) -> Event a -> Event a -> Event a unionWith f = liftCached2 $ (liftBuild .) . Prim.unionWithP f filterJust :: Event (Maybe a) -> Event a filterJust = liftCached1 $ liftBuild . Prim.filterJustP mapE :: (a -> b) -> Event a -> Event b mapE f = liftCached1 $ liftBuild . Prim.mapP f applyE :: Behavior (a -> b) -> Event a -> Event b applyE = liftCached2 $ \(~(lf,_)) px -> liftBuild $ Prim.applyP lf px changesB :: Behavior a -> Event (Future a) changesB = liftCached1 $ \(~(lx,px)) -> liftBuild $ Prim.tagFuture lx px pureB :: a -> Behavior a pureB a = cache $ do p <- runCached never return (Prim.pureL a, p) applyB :: Behavior (a -> b) -> Behavior a -> Behavior b applyB = liftCached2 $ \(~(l1,p1)) (~(l2,p2)) -> liftBuild $ do p3 <- Prim.unionWithP const p1 p2 let l3 = Prim.applyL l1 l2 return (l3,p3) mapB :: (a -> b) -> Behavior a -> Behavior b mapB f = applyB (pureB f) {----------------------------------------------------------------------------- Combinators - accumulation ------------------------------------------------------------------------------} -- Make sure that the cached computation (Event or Behavior) -- is executed eventually during this moment. trim :: Cached Moment a -> Moment (Cached Moment a) trim b = do liftBuildFun Prim.buildLater $ void $ runCached b return b -- Cache a computation at this moment in time -- and make sure that it is performed in the Build monad eventually cacheAndSchedule :: Moment a -> Moment (Cached Moment a) cacheAndSchedule m = ask >>= \r -> liftBuild $ do let c = cache (const m r) -- prevent let-floating! Prim.buildLater $ void $ runReaderT (runCached c) r return c stepperB :: a -> Event a -> Moment (Behavior a) stepperB a e = cacheAndSchedule $ do p0 <- runCached e liftBuild $ do p1 <- Prim.mapP const p0 p2 <- Prim.mapP (const ()) p1 (l,_) <- Prim.accumL a p1 return (l,p2) accumE :: a -> Event (a -> a) -> Moment (Event a) accumE a e1 = cacheAndSchedule $ do p0 <- runCached e1 liftBuild $ do (_,p1) <- Prim.accumL a p0 return p1 {----------------------------------------------------------------------------- Combinators - dynamic event switching ------------------------------------------------------------------------------} liftBuildFun :: (Build a -> Build b) -> Moment a -> Moment b liftBuildFun f m = do r <- ask liftBuild $ f $ runReaderT m r valueB :: Behavior a -> Moment a valueB b = do ~(l,_) <- runCached b liftBuild $ Prim.readLatch l initialBLater :: Behavior a -> Moment a initialBLater = liftBuildFun Prim.buildLaterReadNow . valueB executeP :: Pulse (Moment a) -> Moment (Pulse a) executeP p1 = do r <- ask liftBuild $ do p2 <- Prim.mapP runReaderT p1 Prim.executeP p2 r observeE :: Event (Moment a) -> Event a observeE = liftCached1 $ executeP executeE :: Event (Moment a) -> Moment (Event a) executeE e = do -- Run cached computation later to allow more recursion with `Moment` p <- liftBuildFun Prim.buildLaterReadNow $ executeP =<< runCached e return $ fromPure p switchE :: Event (Event a) -> Moment (Event a) switchE e = ask >>= \r -> cacheAndSchedule $ do p1 <- runCached e liftBuild $ do p2 <- Prim.mapP (runReaderT . runCached) p1 p3 <- Prim.executeP p2 r Prim.switchP p3 switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a) switchB b e = ask >>= \r -> cacheAndSchedule $ do ~(l0,p0) <- runCached b p1 <- runCached e liftBuild $ do p2 <- Prim.mapP (runReaderT . runCached) p1 p3 <- Prim.executeP p2 r lr <- Prim.switchL l0 =<< Prim.mapP fst p3 -- TODO: switch away the initial behavior let c1 = p0 -- initial behavior changes c2 <- Prim.mapP (const ()) p3 -- or switch happens c3 <- Prim.switchP =<< Prim.mapP snd p3 -- or current behavior changes pr <- merge c1 =<< merge c2 c3 return (lr, pr) merge :: Pulse () -> Pulse () -> Build (Pulse ()) merge = Prim.unionWithP (\_ _ -> ()) reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/0000755000000000000000000000000013415425603017502 5ustar0000000000000000reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/IO.hs0000644000000000000000000000370713415425603020354 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} module Reactive.Banana.Prim.IO where import Control.Monad.IO.Class import Data.Functor import Data.IORef import qualified Data.Vault.Lazy as Lazy import Reactive.Banana.Prim.Combinators (mapP) import Reactive.Banana.Prim.Evaluation (step) import Reactive.Banana.Prim.Plumbing import Reactive.Banana.Prim.Types import Reactive.Banana.Prim.Util debug s = id {----------------------------------------------------------------------------- Primitives connecting to the outside world ------------------------------------------------------------------------------} -- | Create a new pulse in the network and a function to trigger it. -- -- Together with 'addHandler', this function can be used to operate with -- pulses as with standard callback-based events. newInput :: forall a. Build (Pulse a, a -> Step) newInput = mdo always <- alwaysP key <- liftIO $ Lazy.newKey pulse <- liftIO $ newRef $ Pulse { _keyP = key , _seenP = agesAgo , _evalP = readPulseP pulse -- get its own value , _childrenP = [] , _parentsP = [] , _levelP = ground , _nameP = "newInput" } -- Also add the alwaysP pulse to the inputs. let run :: a -> Step run a = step ([P pulse, P always], Lazy.insert key (Just a) Lazy.empty) return (pulse, run) -- | Register a handler to be executed whenever a pulse occurs. -- -- The pulse may refer to future latch values. addHandler :: Pulse (Future a) -> (a -> IO ()) -> Build () addHandler p1 f = do p2 <- mapP (fmap f) p1 addOutput p2 -- | Read the value of a 'Latch' at a particular moment in time. readLatch :: Latch a -> Build a readLatch = readLatchB reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Types.hs0000644000000000000000000001737213415425603021154 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE ExistentialQuantification, NamedFieldPuns #-} {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Reactive.Banana.Prim.Types where import Control.Monad.Trans.RWSIO import Control.Monad.Trans.Reader import Control.Monad.Trans.ReaderWriterIO import Data.Functor import Data.Hashable import Data.Monoid (Monoid, mempty, mappend) import Data.Semigroup import qualified Data.Vault.Lazy as Lazy import System.IO.Unsafe import System.Mem.Weak import Reactive.Banana.Prim.Graph (Graph) import Reactive.Banana.Prim.OrderedBag as OB (OrderedBag, empty) import Reactive.Banana.Prim.Util {----------------------------------------------------------------------------- Network ------------------------------------------------------------------------------} -- | A 'Network' represents the state of a pulse/latch network, data Network = Network { nTime :: !Time -- Current time. , nOutputs :: !(OrderedBag Output) -- Remember outputs to prevent garbage collection. , nAlwaysP :: !(Maybe (Pulse ())) -- Pulse that always fires. } type Inputs = ([SomeNode], Lazy.Vault) type EvalNetwork a = Network -> IO (a, Network) type Step = EvalNetwork (IO ()) emptyNetwork :: Network emptyNetwork = Network { nTime = next beginning , nOutputs = OB.empty , nAlwaysP = Nothing } type Build = ReaderWriterIOT BuildR BuildW IO type BuildR = (Time, Pulse ()) -- ( current time -- , pulse that always fires) newtype BuildW = BuildW (DependencyBuilder, [Output], Action, Maybe (Build ())) -- reader : current timestamp -- writer : ( actions that change the network topology -- , outputs to be added to the network -- , late IO actions -- , late build actions -- ) instance Semigroup BuildW where BuildW x <> BuildW y = BuildW (x <> y) instance Monoid BuildW where mempty = BuildW mempty mappend = (<>) type BuildIO = Build type DependencyBuilder = (Endo (Graph SomeNode), [(SomeNode, SomeNode)]) {----------------------------------------------------------------------------- Synonyms ------------------------------------------------------------------------------} -- | Priority used to determine evaluation order for pulses. type Level = Int ground :: Level ground = 0 -- | 'IO' actions as a monoid with respect to sequencing. newtype Action = Action { doit :: IO () } instance Semigroup Action where Action x <> Action y = Action (x >> y) instance Monoid Action where mempty = Action $ return () mappend = (<>) -- | Lens-like functionality. data Lens s a = Lens (s -> a) (a -> s -> s) set :: Lens s a -> a -> s -> s set (Lens _ set) = set update :: Lens s a -> (a -> a) -> s -> s update (Lens get set) f = \s -> set (f $ get s) s {----------------------------------------------------------------------------- Pulse and Latch ------------------------------------------------------------------------------} type Pulse a = Ref (Pulse' a) data Pulse' a = Pulse { _keyP :: Lazy.Key (Maybe a) -- Key to retrieve pulse from cache. , _seenP :: !Time -- See note [Timestamp]. , _evalP :: EvalP (Maybe a) -- Calculate current value. , _childrenP :: [Weak SomeNode] -- Weak references to child nodes. , _parentsP :: [Weak SomeNode] -- Weak reference to parent nodes. , _levelP :: !Level -- Priority in evaluation order. , _nameP :: String -- Name for debugging. } instance Show (Pulse a) where show p = _nameP (unsafePerformIO $ readRef p) ++ " " ++ show (hashWithSalt 0 p) type Latch a = Ref (Latch' a) data Latch' a = Latch { _seenL :: !Time -- Timestamp for the current value. , _valueL :: a -- Current value. , _evalL :: EvalL a -- Recalculate current latch value. } type LatchWrite = Ref LatchWrite' data LatchWrite' = forall a. LatchWrite { _evalLW :: EvalP a -- Calculate value to write. , _latchLW :: Weak (Latch a) -- Destination 'Latch' to write to. } type Output = Ref Output' data Output' = Output { _evalO :: EvalP EvalO } instance Eq Output where (==) = equalRef data SomeNode = forall a. P (Pulse a) | L LatchWrite | O Output instance Hashable SomeNode where hashWithSalt s (P x) = hashWithSalt s x hashWithSalt s (L x) = hashWithSalt s x hashWithSalt s (O x) = hashWithSalt s x instance Eq SomeNode where (P x) == (P y) = equalRef x y (L x) == (L y) = equalRef x y (O x) == (O y) = equalRef x y {-# INLINE mkWeakNodeValue #-} mkWeakNodeValue :: SomeNode -> v -> IO (Weak v) mkWeakNodeValue (P x) = mkWeakRefValue x mkWeakNodeValue (L x) = mkWeakRefValue x mkWeakNodeValue (O x) = mkWeakRefValue x -- Lenses for various parameters seenP :: Lens (Pulse' a) Time seenP = Lens _seenP (\a s -> s { _seenP = a }) seenL :: Lens (Latch' a) Time seenL = Lens _seenL (\a s -> s { _seenL = a }) valueL :: Lens (Latch' a) a valueL = Lens _valueL (\a s -> s { _valueL = a }) parentsP :: Lens (Pulse' a) [Weak SomeNode] parentsP = Lens _parentsP (\a s -> s { _parentsP = a }) childrenP :: Lens (Pulse' a) [Weak SomeNode] childrenP = Lens _childrenP (\a s -> s { _childrenP = a }) levelP :: Lens (Pulse' a) Int levelP = Lens _levelP (\a s -> s { _levelP = a }) -- | Evaluation monads. type EvalPW = (EvalLW, [(Output, EvalO)]) type EvalLW = Action type EvalO = Future (IO ()) type Future = IO -- Note: For efficiency reasons, we unroll the monad transformer stack. -- type EvalP = RWST () Lazy.Vault EvalPW Build type EvalP = RWSIOT BuildR (EvalPW,BuildW) Lazy.Vault IO -- writer : (latch updates, IO action) -- state : current pulse values -- Computation with a timestamp that indicates the last time it was performed. type EvalL = ReaderWriterIOT () Time IO {----------------------------------------------------------------------------- Show functions for debugging ------------------------------------------------------------------------------} printNode :: SomeNode -> IO String printNode (P p) = _nameP <$> readRef p printNode (L l) = return "L" printNode (O o) = return "O" {----------------------------------------------------------------------------- Time monoid ------------------------------------------------------------------------------} -- | A timestamp local to this program run. -- -- Useful e.g. for controlling cache validity. newtype Time = T Integer deriving (Eq, Ord, Show, Read) -- | Before the beginning of time. See Note [TimeStamp] agesAgo :: Time agesAgo = T (-1) beginning :: Time beginning = T 0 next :: Time -> Time next (T n) = T (n+1) instance Semigroup Time where T x <> T y = T (max x y) instance Monoid Time where mappend = (<>) mempty = beginning {----------------------------------------------------------------------------- Notes ------------------------------------------------------------------------------} {- Note [Timestamp] The time stamp indicates how recent the current value is. For Pulse: During pulse evaluation, a time stamp equal to the current time indicates that the pulse has already been evaluated in this phase. For Latch: The timestamp indicates the last time at which the latch has been written to. agesAgo = The latch has never been written to. beginning = The latch has been written to before everything starts. The second description is ensured by the fact that the network writes timestamps that begin at time `next beginning`. -} reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Combinators.hs0000644000000000000000000001116413415425603022321 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo, ScopedTypeVariables #-} module Reactive.Banana.Prim.Combinators where import Control.Applicative import Control.Monad import Control.Monad.IO.Class import Reactive.Banana.Prim.Plumbing ( neverP, newPulse, newLatch, cachedLatch , dependOn, keepAlive, changeParent , getValueL , readPulseP, readLatchP, readLatchFutureP, liftBuildP, ) import qualified Reactive.Banana.Prim.Plumbing (pureL) import Reactive.Banana.Prim.Types (Latch, Future, Pulse, Build, EvalP) import Debug.Trace -- debug s = trace s debug s = id {----------------------------------------------------------------------------- Combinators - basic ------------------------------------------------------------------------------} mapP :: (a -> b) -> Pulse a -> Build (Pulse b) mapP f p1 = do p2 <- newPulse "mapP" $ {-# SCC mapP #-} fmap f <$> readPulseP p1 p2 `dependOn` p1 return p2 -- | Tag a 'Pulse' with future values of a 'Latch'. -- -- This is in contrast to 'applyP' which applies the current value -- of a 'Latch' to a pulse. tagFuture :: Latch a -> Pulse b -> Build (Pulse (Future a)) tagFuture x p1 = do p2 <- newPulse "tagFuture" $ fmap . const <$> readLatchFutureP x <*> readPulseP p1 p2 `dependOn` p1 return p2 filterJustP :: Pulse (Maybe a) -> Build (Pulse a) filterJustP p1 = do p2 <- newPulse "filterJustP" $ {-# SCC filterJustP #-} join <$> readPulseP p1 p2 `dependOn` p1 return p2 unsafeMapIOP :: forall a b. (a -> IO b) -> Pulse a -> Build (Pulse b) unsafeMapIOP f p1 = do p2 <- newPulse "unsafeMapIOP" $ {-# SCC unsafeMapIOP #-} eval =<< readPulseP p1 p2 `dependOn` p1 return p2 where eval :: Maybe a -> EvalP (Maybe b) eval (Just x) = Just <$> liftIO (f x) eval Nothing = return Nothing unionWithP :: forall a. (a -> a -> a) -> Pulse a -> Pulse a -> Build (Pulse a) unionWithP f px py = do p <- newPulse "unionWithP" $ {-# SCC unionWithP #-} eval <$> readPulseP px <*> readPulseP py p `dependOn` px p `dependOn` py return p where eval :: Maybe a -> Maybe a -> Maybe a eval (Just x) (Just y) = Just (f x y) eval (Just x) Nothing = Just x eval Nothing (Just y) = Just y eval Nothing Nothing = Nothing -- See note [LatchRecursion] applyP :: Latch (a -> b) -> Pulse a -> Build (Pulse b) applyP f x = do p <- newPulse "applyP" $ {-# SCC applyP #-} fmap <$> readLatchP f <*> readPulseP x p `dependOn` x return p pureL :: a -> Latch a pureL = Reactive.Banana.Prim.Plumbing.pureL -- specialization of mapL f = applyL (pureL f) mapL :: (a -> b) -> Latch a -> Latch b mapL f lx = cachedLatch $ {-# SCC mapL #-} f <$> getValueL lx applyL :: Latch (a -> b) -> Latch a -> Latch b applyL lf lx = cachedLatch $ {-# SCC applyL #-} getValueL lf <*> getValueL lx accumL :: a -> Pulse (a -> a) -> Build (Latch a, Pulse a) accumL a p1 = do (updateOn, x) <- newLatch a p2 <- applyP (mapL (\x f -> f x) x) p1 updateOn p2 return (x,p2) -- specialization of accumL stepperL :: a -> Pulse a -> Build (Latch a) stepperL a p = do (updateOn, x) <- newLatch a updateOn p return x {----------------------------------------------------------------------------- Combinators - dynamic event switching ------------------------------------------------------------------------------} switchL :: Latch a -> Pulse (Latch a) -> Build (Latch a) switchL l pl = mdo x <- stepperL l pl return $ cachedLatch $ getValueL x >>= getValueL executeP :: forall a b. Pulse (b -> Build a) -> b -> Build (Pulse a) executeP p1 b = do p2 <- newPulse "executeP" $ {-# SCC executeP #-} eval =<< readPulseP p1 p2 `dependOn` p1 return p2 where eval :: Maybe (b -> Build a) -> EvalP (Maybe a) eval (Just x) = Just <$> liftBuildP (x b) eval Nothing = return Nothing switchP :: Pulse (Pulse a) -> Build (Pulse a) switchP pp = mdo never <- neverP lp <- stepperL never pp let -- switch to a new parent switch = do mnew <- readPulseP pp case mnew of Nothing -> return () Just new -> liftBuildP $ p2 `changeParent` new return Nothing -- fetch value from old parent eval = readPulseP =<< readLatchP lp p1 <- newPulse "switchP_in" switch :: Build (Pulse ()) p1 `dependOn` pp p2 <- newPulse "switchP_out" eval p2 `keepAlive` p1 return p2 reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/OrderedBag.hs0000644000000000000000000000332413415425603022036 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana Implementation of a bag whose elements are ordered by arrival time. ------------------------------------------------------------------------------} {-# LANGUAGE TupleSections #-} module Reactive.Banana.Prim.OrderedBag where import Data.Functor import qualified Data.HashMap.Strict as Map import Data.Hashable import Data.List hiding (insert) import Data.Maybe import Data.Ord {----------------------------------------------------------------------------- Ordered Bag ------------------------------------------------------------------------------} type Position = Integer data OrderedBag a = OB !(Map.HashMap a Position) !Position empty :: OrderedBag a empty = OB Map.empty 0 -- | Add an element to an ordered bag after all the others. -- Does nothing if the element is already in the bag. insert :: (Eq a, Hashable a) => OrderedBag a -> a -> OrderedBag a insert (OB xs n) x = OB (Map.insertWith (\new old -> old) x n xs) (n+1) -- | Add a sequence of elements to an ordered bag. -- -- The ordering is left-to-right. For example, the head of the sequence -- comes after all elements in the bag, -- but before the other elements in the sequence. inserts :: (Eq a, Hashable a) => OrderedBag a -> [a] -> OrderedBag a inserts bag xs = foldl insert bag xs -- | Reorder a list of elements to appear as they were inserted into the bag. -- Remove any elements from the list that do not appear in the bag. inOrder :: (Eq a, Hashable a) => [(a,b)] -> OrderedBag a -> [(a,b)] inOrder xs (OB bag _) = map snd $ sortBy (comparing fst) $ mapMaybe (\x -> (,x) <$> Map.lookup (fst x) bag) xs reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Graph.hs0000644000000000000000000000634313415425603021105 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana Implementation of graph-related functionality ------------------------------------------------------------------------------} {-# language ScopedTypeVariables#-} module Reactive.Banana.Prim.Graph where import Control.Monad import Data.Functor.Identity import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as Set import Data.Hashable import Data.Maybe {----------------------------------------------------------------------------- Graphs and topological sorting ------------------------------------------------------------------------------} data Graph a = Graph { children :: Map.HashMap a [a] , parents :: Map.HashMap a [a] , nodes :: Set.HashSet a } -- | The graph with no edges and no nodes. emptyGraph :: Graph a emptyGraph = Graph Map.empty Map.empty Set.empty -- | Insert an edge from the first node to the second node into the graph. insertEdge :: (Eq a, Hashable a) => (a,a) -> Graph a -> Graph a insertEdge (x,y) gr = gr { children = Map.insertWith (flip (++)) x [y] (children gr) , parents = Map.insertWith (flip (++)) y [x] (parents gr) , nodes = Set.insert x $ Set.insert y $ nodes gr } -- | Get all immediate children of a node in a graph. getChildren :: (Eq a, Hashable a) => Graph a -> a -> [a] getChildren gr x = maybe [] id . Map.lookup x . children $ gr -- | Get all immediate parents of a node in a graph. getParents :: (Eq a, Hashable a) => Graph a -> a -> [a] getParents gr x = maybe [] id . Map.lookup x . parents $ gr -- | List all nodes such that each parent is listed before all of its children. listParents :: forall a. (Eq a, Hashable a) => Graph a -> [a] listParents gr = list where -- all nodes without children ancestors :: [a] ancestors = [x | x <- Set.toList $ nodes gr, null (getParents gr x)] -- all nodes in topological order "parents before children" list :: [a] list = runIdentity $ dfs' ancestors (Identity . getChildren gr) {----------------------------------------------------------------------------- Graph traversal ------------------------------------------------------------------------------} -- | Graph represented as map of successors. type GraphM m a = a -> m [a] -- | Depth-first search. List all transitive successors of a node. -- A node is listed *before* all its successors have been listed. dfs :: (Eq a, Hashable a, Monad m) => a -> GraphM m a -> m [a] dfs x = dfs' [x] -- | Depth-first serach, refined version. -- INVARIANT: None of the nodes in the initial list have a predecessor. dfs' :: forall a m. (Eq a, Hashable a, Monad m) => [a] -> GraphM m a -> m [a] dfs' xs succs = liftM fst $ go xs [] Set.empty where go :: [a] -> [a] -> Set.HashSet a -> m ([a], Set.HashSet a) go [] ys seen = return (ys, seen) -- all nodes seen go (x:xs) ys seen | x `Set.member` seen = go xs ys seen | otherwise = do xs' <- succs x -- visit all children (ys', seen') <- go xs' ys (Set.insert x seen) -- list this node as all successors have been seen go xs (x:ys') seen' reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Cached.hs0000644000000000000000000000427113415425603021211 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo #-} module Reactive.Banana.Prim.Cached ( -- | Utility for executing monadic actions once -- and then retrieving values from a cache. -- -- Very useful for observable sharing. Cached, runCached, cache, fromPure, don'tCache, liftCached1, liftCached2, ) where import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class import Data.IORef import System.IO.Unsafe (unsafePerformIO) {----------------------------------------------------------------------------- Cache type ------------------------------------------------------------------------------} data Cached m a = Cached (m a) runCached :: Cached m a -> m a runCached (Cached x) = x -- | An action whose result will be cached. -- Executing the action the first time in the monad will -- execute the side effects. From then on, -- only the generated value will be returned. {-# NOINLINE cache #-} cache :: (MonadFix m, MonadIO m) => m a -> Cached m a cache m = unsafePerformIO $ do key <- liftIO $ newIORef Nothing return $ Cached $ do ma <- liftIO $ readIORef key -- read the cached result case ma of Just a -> return a -- return the cached result. Nothing -> mdo liftIO $ -- write the result already writeIORef key (Just a) a <- m -- evaluate return a -- | Return a pure value. Doesn't make use of the cache. fromPure :: Monad m => a -> Cached m a fromPure = Cached . return -- | Lift an action that is /not/ cached, for instance because it is idempotent. don'tCache :: Monad m => m a -> Cached m a don'tCache = Cached liftCached1 :: (MonadFix m, MonadIO m) => (a -> m b) -> Cached m a -> Cached m b liftCached1 f ca = cache $ do a <- runCached ca f a liftCached2 :: (MonadFix m, MonadIO m) => (a -> b -> m c) -> Cached m a -> Cached m b -> Cached m c liftCached2 f ca cb = cache $ do a <- runCached ca b <- runCached cb f a b reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Dependencies.hs0000644000000000000000000001076713415425603022437 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecordWildCards, NamedFieldPuns #-} module Reactive.Banana.Prim.Dependencies ( -- | Utilities for operating on node dependencies. addChild, changeParent, buildDependencies, ) where import Control.Monad import Data.Functor import Data.Monoid import System.Mem.Weak import qualified Reactive.Banana.Prim.Graph as Graph import Reactive.Banana.Prim.Types import Reactive.Banana.Prim.Util {----------------------------------------------------------------------------- Accumulate dependency information for nodes ------------------------------------------------------------------------------} -- | Add a new child node to a parent node. addChild :: SomeNode -> SomeNode -> DependencyBuilder addChild parent child = (Endo $ Graph.insertEdge (parent,child), mempty) -- | Assign a new parent to a child node. -- INVARIANT: The child may have only one parent node. changeParent :: Pulse a -> Pulse b -> DependencyBuilder changeParent child parent = (mempty, [(P child, P parent)]) -- | Execute the information in the dependency builder -- to change network topology. buildDependencies :: DependencyBuilder -> IO () buildDependencies (Endo f, parents) = do sequence_ [x `doAddChild` y | x <- Graph.listParents gr, y <- Graph.getChildren gr x] sequence_ [x `doChangeParent` y | (P x, P y) <- parents] where gr :: Graph.Graph SomeNode gr = f Graph.emptyGraph {----------------------------------------------------------------------------- Set dependencies of individual notes ------------------------------------------------------------------------------} -- | Add a child node to the children of a parent 'Pulse'. connectChild :: Pulse a -- ^ Parent node whose '_childP' field is to be updated. -> SomeNode -- ^ Child node to add. -> IO (Weak SomeNode) -- ^ Weak reference with the child as key and the parent as value. connectChild parent child = do w <- mkWeakNodeValue child child modify' parent $ update childrenP (w:) mkWeakNodeValue child (P parent) -- child keeps parent alive -- | Add a child node to a parent node and update evaluation order. doAddChild :: SomeNode -> SomeNode -> IO () doAddChild (P parent) (P child) = do level1 <- _levelP <$> readRef child level2 <- _levelP <$> readRef parent let level = level1 `max` (level2 + 1) w <- parent `connectChild` (P child) modify' child $ set levelP level . update parentsP (w:) doAddChild (P parent) node = void $ parent `connectChild` node -- | Remove a node from its parents and all parents from this node. removeParents :: Pulse a -> IO () removeParents child = do c@Pulse{_parentsP} <- readRef child -- delete this child (and dead children) from all parent nodes forM_ _parentsP $ \w -> do Just (P parent) <- deRefWeak w -- get parent node finalize w -- severe connection in garbage collector let isGoodChild w = not . maybe True (== P child) <$> deRefWeak w new <- filterM isGoodChild . _childrenP =<< readRef parent modify' parent $ set childrenP new -- replace parents by empty list put child $ c{_parentsP = []} -- | Set the parent of a pulse to a different pulse. doChangeParent :: Pulse a -> Pulse b -> IO () doChangeParent child parent = do -- remove all previous parents and connect to new parent removeParents child w <- parent `connectChild` (P child) modify' child $ update parentsP (w:) -- calculate level difference between parent and node levelParent <- _levelP <$> readRef parent levelChild <- _levelP <$> readRef child let d = levelParent - levelChild + 1 -- level parent - d = level child - 1 -- lower all parents of the node if the parent was higher than the node when (d > 0) $ do parents <- Graph.dfs (P parent) getParents forM_ parents $ \(P node) -> do modify' node $ update levelP (subtract d) {----------------------------------------------------------------------------- Helper functions ------------------------------------------------------------------------------} getChildren :: SomeNode -> IO [SomeNode] getChildren (P p) = deRefWeaks =<< fmap _childrenP (readRef p) getChildren _ = return [] getParents :: SomeNode -> IO [SomeNode] getParents (P p) = deRefWeaks =<< fmap _parentsP (readRef p) getParents _ = return [] reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Util.hs0000644000000000000000000000516013415425603020755 0ustar0000000000000000{-# LANGUAGE CPP #-} {----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE MagicHash, UnboxedTuples #-} module Reactive.Banana.Prim.Util where import Control.Monad import Control.Monad.IO.Class import Data.Hashable import Data.IORef import Data.Maybe (catMaybes) import Data.Unique.Really import qualified GHC.Base as GHC import qualified GHC.IORef as GHC import qualified GHC.STRef as GHC import qualified GHC.Weak as GHC import System.Mem.Weak debug :: MonadIO m => String -> m () -- debug = liftIO . putStrLn debug _ = return () nop :: Monad m => m () nop = return () {----------------------------------------------------------------------------- IORefs that can be hashed ------------------------------------------------------------------------------} data Ref a = Ref !(IORef a) !Unique instance Hashable (Ref a) where hashWithSalt s (Ref _ u) = hashWithSalt s u equalRef :: Ref a -> Ref b -> Bool equalRef (Ref _ a) (Ref _ b) = a == b newRef :: MonadIO m => a -> m (Ref a) newRef a = liftIO $ liftM2 Ref (newIORef a) newUnique readRef :: MonadIO m => Ref a -> m a readRef ~(Ref ref _) = liftIO $ readIORef ref put :: MonadIO m => Ref a -> a -> m () put ~(Ref ref _) = liftIO . writeIORef ref -- | Strictly modify an 'IORef'. modify' :: MonadIO m => Ref a -> (a -> a) -> m () modify' ~(Ref ref _) f = liftIO $ readIORef ref >>= \x -> writeIORef ref $! f x {----------------------------------------------------------------------------- Weak pointers ------------------------------------------------------------------------------} mkWeakIORefValueFinalizer :: IORef a -> value -> IO () -> IO (Weak value) #if MIN_VERSION_base(4,9,0) mkWeakIORefValueFinalizer r@(GHC.IORef (GHC.STRef r#)) v (GHC.IO f) = GHC.IO $ \s -> case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #) #else mkWeakIORefValueFinalizer r@(GHC.IORef (GHC.STRef r#)) v f = GHC.IO $ \s -> case GHC.mkWeak# r# v f s of (# s1, w #) -> (# s1, GHC.Weak w #) #endif mkWeakIORefValue :: IORef a -> value -> IO (Weak value) mkWeakIORefValue a b = mkWeakIORefValueFinalizer a b (return ()) mkWeakRefValue :: MonadIO m => Ref a -> value -> m (Weak value) mkWeakRefValue (Ref ref _) v = liftIO $ mkWeakIORefValue ref v -- | Dereference a list of weak pointers while discarding dead ones. deRefWeaks :: [Weak v] -> IO [v] deRefWeaks ws = {-# SCC deRefWeaks #-} fmap catMaybes $ mapM deRefWeak ws reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Evaluation.hs0000644000000000000000000001207713415425603022154 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecordWildCards, BangPatterns #-} module Reactive.Banana.Prim.Evaluation ( step ) where import qualified Control.Exception as Strict (evaluate) import Control.Monad (foldM) import Control.Monad (join) import Control.Monad.IO.Class import qualified Control.Monad.Trans.RWSIO as RWS import qualified Control.Monad.Trans.ReaderWriterIO as RW import Data.Functor import Data.Maybe import qualified Data.PQueue.Prio.Min as Q import qualified Data.Vault.Lazy as Lazy import System.Mem.Weak import qualified Reactive.Banana.Prim.OrderedBag as OB import Reactive.Banana.Prim.Plumbing import Reactive.Banana.Prim.Types import Reactive.Banana.Prim.Util type Queue = Q.MinPQueue Level {----------------------------------------------------------------------------- Evaluation step ------------------------------------------------------------------------------} -- | Evaluate all the pulses in the graph, -- Rebuild the graph as necessary and update the latch values. step :: Inputs -> Step step (inputs,pulses) Network{ nTime = time1 , nOutputs = outputs1 , nAlwaysP = Just alwaysP -- we assume that this has been built already } = {-# SCC step #-} do -- evaluate pulses ((_, (latchUpdates, outputs)), topologyUpdates, os) <- runBuildIO (time1, alwaysP) $ runEvalP pulses $ evaluatePulses inputs doit latchUpdates -- update latch values from pulses doit topologyUpdates -- rearrange graph topology let actions :: [(Output, EvalO)] actions = OB.inOrder outputs outputs1 -- EvalO actions in proper order state2 :: Network state2 = Network { nTime = next time1 , nOutputs = OB.inserts outputs1 os , nAlwaysP = Just alwaysP } return (runEvalOs $ map snd actions, state2) runEvalOs :: [EvalO] -> IO () runEvalOs = sequence_ . map join {----------------------------------------------------------------------------- Traversal in dependency order ------------------------------------------------------------------------------} -- | Update all pulses in the graph, starting from a given set of nodes evaluatePulses :: [SomeNode] -> EvalP () evaluatePulses roots = wrapEvalP $ \r -> go r =<< insertNodes r roots Q.empty where go :: RWS.Tuple BuildR (EvalPW, BuildW) Lazy.Vault -> Queue SomeNode -> IO () go r q = {-# SCC go #-} case ({-# SCC minView #-} Q.minView q) of Nothing -> return () Just (node, q) -> do children <- unwrapEvalP r (evaluateNode node) q <- insertNodes r children q go r q -- | Recalculate a given node and return all children nodes -- that need to evaluated subsequently. evaluateNode :: SomeNode -> EvalP [SomeNode] evaluateNode (P p) = {-# SCC evaluateNodeP #-} do Pulse{..} <- readRef p ma <- _evalP writePulseP _keyP ma case ma of Nothing -> return [] Just _ -> liftIO $ deRefWeaks _childrenP evaluateNode (L lw) = {-# SCC evaluateNodeL #-} do time <- askTime LatchWrite{..} <- readRef lw mlatch <- liftIO $ deRefWeak _latchLW -- retrieve destination latch case mlatch of Nothing -> return () Just latch -> do a <- _evalLW -- calculate new latch value -- liftIO $ Strict.evaluate a -- see Note [LatchStrictness] rememberLatchUpdate $ -- schedule value to be set later modify' latch $ \l -> a `seq` l { _seenL = time, _valueL = a } return [] evaluateNode (O o) = {-# SCC evaluateNodeO #-} do debug "evaluateNode O" Output{..} <- readRef o m <- _evalO -- calculate output action rememberOutput $ (o,m) return [] -- | Insert nodes into the queue insertNodes :: RWS.Tuple BuildR (EvalPW, BuildW) Lazy.Vault -> [SomeNode] -> Queue SomeNode -> IO (Queue SomeNode) insertNodes (RWS.Tuple (time,_) _ _) = {-# SCC insertNodes #-} go where go :: [SomeNode] -> Queue SomeNode -> IO (Queue SomeNode) go [] q = return q go (node@(P p):xs) q = do Pulse{..} <- readRef p if time <= _seenP then go xs q -- pulse has already been put into the queue once else do -- pulse needs to be scheduled for evaluation put p $! (let p = Pulse{..} in p { _seenP = time }) go xs (Q.insert _levelP node q) go (node:xs) q = go xs (Q.insert ground node q) -- O and L nodes have only one parent, so -- we can insert them at an arbitrary level reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Test.hs0000644000000000000000000000237513415425603020764 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecursiveDo #-} module Reactive.Banana.Prim.Test where import Control.Applicative import Reactive.Banana.Prim main = test_space1 {----------------------------------------------------------------------------- Functionality tests ------------------------------------------------------------------------------} test_accumL1 :: Pulse Int -> BuildIO (Pulse Int) test_accumL1 p1 = liftBuild $ do p2 <- mapP (+) p1 (l1,_) <- accumL 0 p2 let l2 = mapL const l1 p3 <- applyP l2 p1 return p3 test_recursion1 :: Pulse () -> BuildIO (Pulse Int) test_recursion1 p1 = liftBuild $ mdo p2 <- applyP l2 p1 p3 <- mapP (const (+1)) p2 ~(l1,_) <- accumL (0::Int) p3 let l2 = mapL const l1 return p2 -- test garbage collection {----------------------------------------------------------------------------- Space leak tests ------------------------------------------------------------------------------} test_space1 = runSpaceProfile test_accumL1 $ [1..2*10^4] test_space2 = runSpaceProfile test_recursion1 $ () <$ [1..2*10^4] reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Plumbing.hs0000644000000000000000000002102713415425603021615 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE RecordWildCards, RecursiveDo, BangPatterns, ScopedTypeVariables #-} module Reactive.Banana.Prim.Plumbing where import Control.Monad (join) import Control.Monad.IO.Class import Control.Monad.Trans.Class import qualified Control.Monad.Trans.RWSIO as RWS import qualified Control.Monad.Trans.Reader as Reader import qualified Control.Monad.Trans.ReaderWriterIO as RW import Data.Function (on) import Data.Functor import Data.IORef import Data.List (sortBy) import Data.Monoid import qualified Data.Vault.Lazy as Lazy import System.IO.Unsafe import qualified Reactive.Banana.Prim.Dependencies as Deps import Reactive.Banana.Prim.Types import Reactive.Banana.Prim.Util {----------------------------------------------------------------------------- Build primitive pulses and latches ------------------------------------------------------------------------------} -- | Make 'Pulse' from evaluation function newPulse :: String -> EvalP (Maybe a) -> Build (Pulse a) newPulse name eval = liftIO $ do key <- Lazy.newKey newRef $ Pulse { _keyP = key , _seenP = agesAgo , _evalP = eval , _childrenP = [] , _parentsP = [] , _levelP = ground , _nameP = name } {- * Note [PulseCreation] We assume that we do not have to calculate a pulse occurrence at the moment we create the pulse. Otherwise, we would have to recalculate the dependencies *while* doing evaluation; this is a recipe for desaster. -} -- | 'Pulse' that never fires. neverP :: Build (Pulse a) neverP = liftIO $ do key <- Lazy.newKey newRef $ Pulse { _keyP = key , _seenP = agesAgo , _evalP = return Nothing , _childrenP = [] , _parentsP = [] , _levelP = ground , _nameP = "neverP" } -- | Return a 'Latch' that has a constant value pureL :: a -> Latch a pureL a = unsafePerformIO $ newRef $ Latch { _seenL = beginning , _valueL = a , _evalL = return a } -- | Make new 'Latch' that can be updated by a 'Pulse' newLatch :: forall a. a -> Build (Pulse a -> Build (), Latch a) newLatch a = mdo latch <- liftIO $ newRef $ Latch { _seenL = beginning , _valueL = a , _evalL = do Latch {..} <- readRef latch RW.tell _seenL -- indicate timestamp return _valueL -- indicate value } let err = error "incorrect Latch write" updateOn :: Pulse a -> Build () updateOn p = do w <- liftIO $ mkWeakRefValue latch latch lw <- liftIO $ newRef $ LatchWrite { _evalLW = maybe err id <$> readPulseP p , _latchLW = w } -- writer is alive only as long as the latch is alive _ <- liftIO $ mkWeakRefValue latch lw (P p) `addChild` (L lw) return (updateOn, latch) -- | Make a new 'Latch' that caches a previous computation. cachedLatch :: EvalL a -> Latch a cachedLatch eval = unsafePerformIO $ mdo latch <- newRef $ Latch { _seenL = agesAgo , _valueL = error "Undefined value of a cached latch." , _evalL = do Latch{..} <- liftIO $ readRef latch -- calculate current value (lazy!) with timestamp (a,time) <- RW.listen eval liftIO $ if time <= _seenL then return _valueL -- return old value else do -- update value let _seenL = time let _valueL = a a `seq` put latch (Latch {..}) return a } return latch -- | Add a new output that depends on a 'Pulse'. -- -- TODO: Return function to unregister the output again. addOutput :: Pulse EvalO -> Build () addOutput p = do o <- liftIO $ newRef $ Output { _evalO = maybe (return $ debug "nop") id <$> readPulseP p } (P p) `addChild` (O o) RW.tell $ BuildW (mempty, [o], mempty, mempty) {----------------------------------------------------------------------------- Build monad ------------------------------------------------------------------------------} runBuildIO :: BuildR -> BuildIO a -> IO (a, Action, [Output]) runBuildIO i m = {-# SCC runBuild #-} do (a, BuildW (topologyUpdates, os, liftIOLaters, _)) <- unfold mempty m doit $ liftIOLaters -- execute late IOs return (a,Action $ Deps.buildDependencies topologyUpdates,os) where -- Recursively execute the buildLater calls. unfold :: BuildW -> BuildIO a -> IO (a, BuildW) unfold w m = do (a, BuildW (w1, w2, w3, later)) <- RW.runReaderWriterIOT m i let w' = w <> BuildW (w1,w2,w3,mempty) w'' <- case later of Just m -> snd <$> unfold w' m Nothing -> return w' return (a,w'') buildLater :: Build () -> Build () buildLater x = RW.tell $ BuildW (mempty, mempty, mempty, Just x) -- | Pretend to return a value right now, -- but do not actually calculate it until later. -- -- NOTE: Accessing the value before it's written leads to an error. -- -- FIXME: Is there a way to have the value calculate on demand? buildLaterReadNow :: Build a -> Build a buildLaterReadNow m = do ref <- liftIO $ newIORef $ error "buildLaterReadNow: Trying to read before it is written." buildLater $ m >>= liftIO . writeIORef ref liftIO $ unsafeInterleaveIO $ readIORef ref liftBuild :: Build a -> BuildIO a liftBuild = id getTimeB :: Build Time getTimeB = (\(x,_) -> x) <$> RW.ask alwaysP :: Build (Pulse ()) alwaysP = (\(_,x) -> x) <$> RW.ask readLatchB :: Latch a -> Build a readLatchB = liftIO . readLatchIO dependOn :: Pulse child -> Pulse parent -> Build () dependOn child parent = (P parent) `addChild` (P child) keepAlive :: Pulse child -> Pulse parent -> Build () keepAlive child parent = liftIO $ mkWeakRefValue child parent >> return () addChild :: SomeNode -> SomeNode -> Build () addChild parent child = RW.tell $ BuildW (Deps.addChild parent child, mempty, mempty, mempty) changeParent :: Pulse child -> Pulse parent -> Build () changeParent node parent = RW.tell $ BuildW (Deps.changeParent node parent, mempty, mempty, mempty) liftIOLater :: IO () -> Build () liftIOLater x = RW.tell $ BuildW (mempty, mempty, Action x, mempty) {----------------------------------------------------------------------------- EvalL monad ------------------------------------------------------------------------------} -- | Evaluate a latch (-computation) at the latest time, -- but discard timestamp information. readLatchIO :: Latch a -> IO a readLatchIO latch = do Latch{..} <- readRef latch liftIO $ fst <$> RW.runReaderWriterIOT _evalL () getValueL :: Latch a -> EvalL a getValueL latch = do Latch{..} <- readRef latch _evalL {----------------------------------------------------------------------------- EvalP monad ------------------------------------------------------------------------------} runEvalP :: Lazy.Vault -> EvalP a -> Build (a, EvalPW) runEvalP s1 m = RW.readerWriterIOT $ \r2 -> do (a,_,(w1,w2)) <- RWS.runRWSIOT m r2 s1 return ((a,w1), w2) liftBuildP :: Build a -> EvalP a liftBuildP m = RWS.rwsT $ \r2 s -> do (a,w2) <- RW.runReaderWriterIOT m r2 return (a,s,(mempty,w2)) askTime :: EvalP Time askTime = fst <$> RWS.ask readPulseP :: Pulse a -> EvalP (Maybe a) readPulseP p = do Pulse{..} <- readRef p join . Lazy.lookup _keyP <$> RWS.get writePulseP :: Lazy.Key (Maybe a) -> Maybe a -> EvalP () writePulseP key a = do s <- RWS.get RWS.put $ Lazy.insert key a s readLatchP :: Latch a -> EvalP a readLatchP = liftBuildP . readLatchB readLatchFutureP :: Latch a -> EvalP (Future a) readLatchFutureP = return . readLatchIO rememberLatchUpdate :: IO () -> EvalP () rememberLatchUpdate x = RWS.tell ((Action x,mempty),mempty) rememberOutput :: (Output, EvalO) -> EvalP () rememberOutput x = RWS.tell ((mempty,[x]),mempty) -- worker wrapper to break sharing and support better inlining unwrapEvalP :: RWS.Tuple r w s -> RWS.RWSIOT r w s m a -> m a unwrapEvalP r m = RWS.run m r wrapEvalP :: (RWS.Tuple r w s -> m a) -> RWS.RWSIOT r w s m a wrapEvalP m = RWS.R m reactive-banana-1.2.1.0/src/Reactive/Banana/Prim/Compile.hs0000644000000000000000000000740513415425603021434 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} {-# LANGUAGE BangPatterns #-} module Reactive.Banana.Prim.Compile where import Control.Exception (evaluate) import Control.Monad (void) import Data.Functor import Data.IORef import Reactive.Banana.Prim.Combinators import Reactive.Banana.Prim.IO import qualified Reactive.Banana.Prim.OrderedBag as OB import Reactive.Banana.Prim.Plumbing import Reactive.Banana.Prim.Types {----------------------------------------------------------------------------- Compilation ------------------------------------------------------------------------------} -- | Change a 'Network' of pulses and latches by -- executing a 'BuildIO' action. compile :: BuildIO a -> Network -> IO (a, Network) compile m state1 = do let time1 = nTime state1 outputs1 = nOutputs state1 theAlwaysP <- case nAlwaysP state1 of Just x -> return x Nothing -> do (x,_,_) <- runBuildIO undefined $ newPulse "alwaysP" (return $ Just ()) return x (a, topology, os) <- runBuildIO (nTime state1, theAlwaysP) m doit topology let state2 = Network { nTime = next time1 , nOutputs = OB.inserts outputs1 os , nAlwaysP = Just theAlwaysP } return (a,state2) {----------------------------------------------------------------------------- Testing ------------------------------------------------------------------------------} -- | Simple interpreter for pulse/latch networks. -- -- Mainly useful for testing functionality -- -- Note: The result is not computed lazily, for similar reasons -- that the 'sequence' function does not compute its result lazily. interpret :: (Pulse a -> BuildIO (Pulse b)) -> [Maybe a] -> IO [Maybe b] interpret f xs = do o <- newIORef Nothing let network = do (pin, sin) <- liftBuild $ newInput pmid <- f pin pout <- liftBuild $ mapP return pmid liftBuild $ addHandler pout (writeIORef o . Just) return sin -- compile initial network (sin, state) <- compile network emptyNetwork let go Nothing s1 = return (Nothing,s1) go (Just a) s1 = do (reactimate,s2) <- sin a s1 reactimate -- write output ma <- readIORef o -- read output writeIORef o Nothing return (ma,s2) mapAccumM go state xs -- run several steps -- | Execute an FRP network with a sequence of inputs. -- Make sure that outputs are evaluated, but don't display their values. -- -- Mainly useful for testing whether there are space leaks. runSpaceProfile :: Show b => (Pulse a -> BuildIO (Pulse b)) -> [a] -> IO () runSpaceProfile f xs = do let g = do (p1, fire) <- liftBuild $ newInput p2 <- f p1 p3 <- mapP return p2 -- wrap into Future addHandler p3 (\b -> void $ evaluate b) return fire (step,network) <- compile g emptyNetwork let fire x s1 = do (outputs, s2) <- step x s1 outputs -- don't forget to execute outputs return ((), s2) mapAccumM_ fire network xs -- | 'mapAccum' for a monad. mapAccumM :: Monad m => (a -> s -> m (b,s)) -> s -> [a] -> m [b] mapAccumM _ _ [] = return [] mapAccumM f s0 (x:xs) = do (b,s1) <- f x s0 bs <- mapAccumM f s1 xs return (b:bs) -- | Strict 'mapAccum' for a monad. Discards results. mapAccumM_ :: Monad m => (a -> s -> m (b,s)) -> s -> [a] -> m () mapAccumM_ _ _ [] = return () mapAccumM_ f !s0 (x:xs) = do (_,s1) <- f x s0 mapAccumM_ f s1 xs reactive-banana-1.2.1.0/src/Reactive/Banana/Test/0000755000000000000000000000000013415425603017512 5ustar0000000000000000reactive-banana-1.2.1.0/src/Reactive/Banana/Test/Plumbing.hs0000644000000000000000000000725313415425603021632 0ustar0000000000000000{----------------------------------------------------------------------------- reactive-banana ------------------------------------------------------------------------------} -- * Synopsis -- | Merge model and implementation into a single type. Not pretty. module Reactive.Banana.Test.Plumbing where import Control.Applicative import Control.Monad (liftM, ap) import Control.Monad.Fix import qualified Reactive.Banana.Model as X import qualified Reactive.Banana.Internal.Combinators as Y {----------------------------------------------------------------------------- Types as pairs ------------------------------------------------------------------------------} data Event a = E (X.Event a) (Y.Event a) data Behavior a = B (X.Behavior a) (Y.Behavior a) data Moment a = M (X.Moment a) (Y.Moment a) -- pair extractions fstE (E x _) = x; sndE (E _ y) = y fstB (B x _) = x; sndB (B _ y) = y fstM (M x _) = x; sndM (M _ y) = y -- partial embedding functions ex x = E x undefined; ey y = E undefined y bx x = B x undefined; by y = B undefined y mx x = M x undefined; my y = M undefined y -- interpretation interpretModel :: (Event a -> Moment (Event b)) -> [Maybe a] -> [Maybe b] interpretModel f = X.interpret (fmap fstE . fstM . f . ex) interpretGraph :: (Event a -> Moment (Event b)) -> [Maybe a] -> IO [Maybe b] interpretGraph f = Y.interpret (fmap sndE . sndM . f . ey) {----------------------------------------------------------------------------- Primitive combinators ------------------------------------------------------------------------------} never = E X.never Y.never filterJust (E x y) = E (X.filterJust x) (Y.filterJust y) unionWith f (E x1 y1) (E x2 y2) = E (X.unionWith f x1 x2) (Y.unionWith f y1 y2) mapE f (E x y) = E (fmap f x) (Y.mapE f y) applyE ~(B x1 y1) (E x2 y2) = E (X.apply x1 x2) (Y.applyE y1 y2) instance Functor Event where fmap = mapE pureB a = B (pure a) (Y.pureB a) applyB (B x1 y1) (B x2 y2) = B (x1 <*> x2) (Y.applyB y1 y2) mapB f (B x y) = B (fmap f x) (Y.mapB f y) instance Functor Behavior where fmap = mapB instance Applicative Behavior where pure = pureB; (<*>) = applyB instance Functor Moment where fmap = liftM instance Applicative Moment where pure = return (<*>) = ap instance Monad Moment where return a = M (return a) (return a) ~(M x y) >>= g = M (x >>= fstM . g) (y >>= sndM . g) instance MonadFix Moment where mfix f = M (mfix fx) (mfix fy) where fx a = let M x _ = f a in x fy a = let M _ y = f a in y accumE a ~(E x y) = M (fmap ex $ X.accumE a x) (fmap ey $ Y.accumE a y) stepperB a ~(E x y) = M (fmap bx $ X.stepper a x) (fmap by $ Y.stepperB a y) stepper = stepperB valueB ~(B x y) = M (X.valueB x) (Y.valueB y) observeE :: Event (Moment a) -> Event a observeE (E x y) = E (X.observeE $ fmap fstM x) (Y.observeE $ Y.mapE sndM y) switchE :: Event (Event a) -> Moment (Event a) switchE (E x y) = M (fmap ex $ X.switchE $ fmap (fstE) x) (fmap ey $ Y.switchE $ Y.mapE (sndE) y) switchB :: Behavior a -> Event (Behavior a) -> Moment (Behavior a) switchB (B x y) (E xe ye) = M (fmap bx $ X.switchB x $ fmap (fstB) xe) (fmap by $ Y.switchB y $ Y.mapE (sndB) ye) {----------------------------------------------------------------------------- Derived combinators ------------------------------------------------------------------------------} accumB acc e1 = do e2 <- accumE acc e1 stepperB acc e2 whenE b = filterJust . applyE ((\b e -> if b then Just e else Nothing) <$> b) infixl 4 <@>, <@ b <@ e = applyE (const <$> b) e b <@> e = applyE b e