Yampa 0.13 → 0.13.1
raw patch · 7 files changed
+60/−24 lines, 7 filesdep +faildep ~basenew-component:exe:yampa-examples-elevatornew-component:exe:yampa-examples-tailgatingdetectorPVP ok
version bump matches the API change (PVP)
Dependencies added: fail
Dependency ranges changed: base
API changes (from Hackage documentation)
+ FRP.Yampa.Event: instance Control.Monad.Fail.MonadFail FRP.Yampa.Event.Event
Files
- CHANGELOG +11/−1
- Yampa.cabal +25/−1
- examples/Elevator/Elevator.hs +10/−11
- examples/Elevator/TestElevatorMain.hs +1/−3
- examples/TailgatingDetector/TailgatingDetector.hs +1/−2
- examples/TailgatingDetector/TestTGMain.hs +3/−5
- src/FRP/Yampa/Event.hs +9/−1
CHANGELOG view
@@ -1,6 +1,16 @@+2019-10-15 Ivan Perez <ivan.perez@keera.co.uk>+ * Yampa.cabal: Version bump (0.13.1), introduce examples+ as executables, depend on fail if needed.+ * README.md: Add Peoplemon.+ * examples/: Fix errors due to module reorg.+ * extensions/: Chnage testing to use tasty.+ * .travis.yml: Compile with GHC8.8.+ * src/: Support MonadFail proposal and GHC 8.8.+ * Thanks to @sigrlami, @RyanGlScott and @CraigTreptow.+ 2018-11-02 Ivan Perez <ivan.perez@keera.co.uk> * Yampa.cabal: Version bump (0.13).- * README.md: Documents relatec projects.+ * README.md: Documents related projects. * src/: Cleans API, removes deprecated constructs, moves vector and points into separate library, hides Core, eliminates Forceable and MergeableRecord, adds documentation.
Yampa.cabal view
@@ -1,5 +1,5 @@ name: Yampa-version: 0.13+version: 0.13.1 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE@@ -62,6 +62,8 @@ hs-source-dirs: src ghc-options : -O3 -Wall -fno-warn-name-shadowing build-Depends: base < 6, random, deepseq, simple-affine-space+ if !impl(ghc>=8.0)+ build-Depends: fail == 4.9.* exposed-modules: -- Main FRP modules FRP.Yampa@@ -159,6 +161,28 @@ if flag(examples) buildable: True build-depends: base < 5, random, deepseq, SDL, hcwiid, Yampa+ else+ buildable: False++executable yampa-examples-elevator+ main-is: TestElevatorMain.hs+ other-modules: Elevator+ hs-source-dirs: examples/Elevator+ ghc-options : -O3 -Wall -fno-warn-name-shadowing+ if flag(examples)+ buildable: True+ build-depends: base < 5, Yampa+ else+ buildable: False++executable yampa-examples-tailgatingdetector+ main-is: TestTGMain.hs+ other-modules: TailgatingDetector+ hs-source-dirs: examples/TailgatingDetector+ ghc-options : -O3 -Wall -fno-warn-name-shadowing+ if flag(examples)+ buildable: True+ build-depends: base < 5, Yampa else buildable: False
examples/Elevator/Elevator.hs view
@@ -18,7 +18,6 @@ module Elevator where import FRP.Yampa-import FRP.Yampa.Utilities -- ((^<<), dHold) ------------------------------------------------------------------------------ -- Auxiliary definitions@@ -56,22 +55,22 @@ goUp `tag` upRate `lMerge` goDown `tag` (-downRate)- - y <- (lower +) ^<< integral -< v - ++ y <- (lower +) ^<< integral -< v+ let atBottom = y <= lower atTop = y >= upper stopped = v == 0 -- Somewhat dubious ...- + waitingBottom = atBottom && stopped waitingTop = atTop && stopped- + arriveBottom <- edge -< atBottom arriveTop <- edge -< atTop- + let setUp = lbp `tag` True setDown = rbp `tag` True- + -- This does not work. The reset events would be generated as soon -- as the corresponding go event was generated, but the latter -- depend instantaneusly on the reset signals.@@ -92,10 +91,10 @@ -- But that does not seem to be the right solution to me. upPending <- hold False -< setUp `lMerge` resetUp downPending <- hold False -< setDown `lMerge` resetDown- + let pending = upPending || downPending eitherButton = lbp `lMerge` rbp- + goDown = arriveTop `gate` pending `lMerge` eitherButton `gate` waitingTop@@ -103,5 +102,5 @@ `lMerge` eitherButton `gate` waitingBottom stop = (arriveTop `lMerge` arriveBottom) `gate` not pending- + returnA -< y
examples/Elevator/TestElevatorMain.hs view
@@ -17,8 +17,6 @@ import Data.Maybe (catMaybes) import FRP.Yampa-import FRP.Yampa.Utilities-import FRP.Yampa.Internals -- Just for testing purposes. import Elevator @@ -53,7 +51,7 @@ where feAux _ _ [] = [] feAux sPre yPre ((t, ((lbp, rbp), y)) : tios') =- if not (null message) then + if not (null message) then (t, y, message) : feAux s y tios' else feAux s y tios'
examples/TailgatingDetector/TailgatingDetector.hs view
@@ -45,7 +45,6 @@ import FRP.Yampa import FRP.Yampa.Conditional import FRP.Yampa.EventS-import FRP.Yampa.Utilities ------------------------------------------------------------------------------@@ -304,7 +303,7 @@ sameOrder [] _ = False sameOrder _ [] = False sameOrder ((i,_):ics) ((i',_):ics')- | i == i' = sameOrder ics ics' + | i == i' = sameOrder ics ics' | otherwise = False updateTGDs is (MTGDCol iitgs) = MTGDCol $
examples/TailgatingDetector/TestTGMain.hs view
@@ -18,8 +18,6 @@ import Data.List (sortBy) import FRP.Yampa-import FRP.Yampa.Utilities-import FRP.Yampa.Internals -- Just for testing purposes. import TailgatingDetector @@ -40,7 +38,7 @@ /= (map fst (sortBy comparePos v)) then Just v else- Nothing + Nothing comparePos (_, (p1, _)) (_, (p2, _)) = compare p1 p2 @@ -76,7 +74,7 @@ /= (map fst (sortBy comparePos v)) then Just v else- Nothing + Nothing comparePos (_, (p1, _)) (_, (p2, _)) = compare p1 p2 @@ -91,7 +89,7 @@ &&& (proc _ -> do s <- uavStatus -< () h <- highway -< () (v, ect) <- mkVideoAndTrackers -< (h, s)- (ics, etgs) <- findTailgaters -< (v,s,ect) + (ics, etgs) <- findTailgaters -< (v,s,ect) etgs <- mtgd -< ics returnA -< (etgs, ics))) (deltaEncode smplPer (repeat ()))
src/FRP/Yampa/Event.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} ----------------------------------------------------------------------------------------- -- |@@ -90,6 +91,7 @@ import Control.Applicative import Control.DeepSeq (NFData(..))+import qualified Control.Monad.Fail as Fail import FRP.Yampa.Diagnostics @@ -175,9 +177,15 @@ -- | See 'pure'. return = pure++#if !(MIN_VERSION_base(4,13,0)) -- | Fail with 'NoEvent'.- fail _ = NoEvent+ fail = Fail.fail+#endif +instance Fail.MonadFail Event where+ -- | Fail with 'NoEvent'.+ fail _ = NoEvent -- | Alternative instance instance Alternative Event where