Yampa 0.12 → 0.13

raw patch · 28 files changed

+298/−1290 lines, 28 filesdep +simple-affine-spacedep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: simple-affine-space

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +9/−0
• Yampa.cabal +10/−22
• examples/Diagrams.hs +62/−0
• src/FRP/Yampa.hs +95/−75
• src/FRP/Yampa/AffineSpace.hs +0/−51
• src/FRP/Yampa/Arrow.hs +55/−0
• src/FRP/Yampa/Core.hs +0/−48
• src/FRP/Yampa/Diagnostics.hs +1/−1
• src/FRP/Yampa/Event.hs +1/−9
• src/FRP/Yampa/EventS.hs +25/−6
• src/FRP/Yampa/Forceable.hs +0/−79
• src/FRP/Yampa/Geometry.hs +0/−28
• src/FRP/Yampa/Integration.hs +2/−1
• src/FRP/Yampa/InternalCore.hs +18/−2
• src/FRP/Yampa/Internals.hs +0/−24
• src/FRP/Yampa/Loop.hs +1/−1
• src/FRP/Yampa/MergeableRecord.hs +0/−89
• src/FRP/Yampa/Miscellany.hs +0/−211
• src/FRP/Yampa/Point2.hs +0/−59
• src/FRP/Yampa/Point3.hs +0/−67
• src/FRP/Yampa/Task.hs +2/−37
• src/FRP/Yampa/Utilities.hs +0/−62
• src/FRP/Yampa/Vector2.hs +0/−108
• src/FRP/Yampa/Vector3.hs +0/−127
• src/FRP/Yampa/VectorSpace.hs +0/−178
• tests/AFRPTestsTask.hs +16/−2
• tests/AFRPTestsUtils.hs +0/−1
• tests/HaddockCoverage.hs +1/−2

@@ -1,3 +1,12 @@+2018-11-02 Ivan Perez <ivan.perez@keera.co.uk>+        * Yampa.cabal: Version bump (0.13).+        * README.md: Documents relatec projects.+        * src/: Cleans API, removes deprecated constructs, moves+          vector and points into separate library, hides Core,+          eliminates Forceable and MergeableRecord, adds documentation.+        * examples/: Adds Diagrams example.+        * .travis.yml: Compile with GHC8.6 (allowing failures).+ 2018-10-21 Ivan Perez <ivan.perez@keera.co.uk>         * Yampa.cabal: Version bump (0.12).         * README.md: Documents testing.

@@ -1,13 +1,13 @@ name: Yampa-version: 0.12+version: 0.13 cabal-version: >= 1.8 license: BSD3 license-file: LICENSE author: Henrik Nilsson, Antony Courtney maintainer: Ivan Perez (ivan.perez@keera.co.uk)-homepage: http://www.haskell.org/haskellwiki/Yampa+homepage: https://github.com/ivanperez-keera/Yampa/ category: Reactivity, FRP-synopsis: Library for programming hybrid systems.+synopsis: Elegant Functional Reactive Programming Language for Hybrid Systems  description:  Domain-specific language embedded in Haskell for programming               hybrid (mixed discrete-time and continuous-time) systems. Yampa is based on@@ -31,6 +31,7 @@   examples/Elevator/TestElevatorMain.hs,   examples/TailgatingDetector/TailgatingDetector.hs,   examples/TailgatingDetector/TestTGMain.hs,+  examples/Diagrams.hs,    CHANGELOG @@ -60,35 +61,17 @@ library   hs-source-dirs:  src   ghc-options : -O3 -Wall -fno-warn-name-shadowing-  build-Depends: base < 5, random, deepseq+  build-Depends: base < 6, random, deepseq, simple-affine-space   exposed-modules:     -- Main FRP modules     FRP.Yampa     FRP.Yampa.Event-    FRP.Yampa.Internals     FRP.Yampa.Task -    -- FRP Core (minimal complete definition)-    FRP.Yampa.Core--    -- Auxiliary (commonly used) types-    FRP.Yampa.AffineSpace-    FRP.Yampa.Geometry-    FRP.Yampa.Point2-    FRP.Yampa.Point3-    FRP.Yampa.Vector2-    FRP.Yampa.Vector3-    FRP.Yampa.VectorSpace-     -- Auxiliary definitions-    FRP.Yampa.Forceable-    FRP.Yampa.MergeableRecord-    FRP.Yampa.Miscellany-    FRP.Yampa.Utilities     FRP.Yampa.Basic     FRP.Yampa.Conditional     FRP.Yampa.Delays-    FRP.Yampa.Diagnostics     FRP.Yampa.EventS     FRP.Yampa.Hybrid     FRP.Yampa.Integration@@ -99,7 +82,12 @@     FRP.Yampa.Switches     FRP.Yampa.Time +    -- FRP-agnostic auxiliary definitions+    FRP.Yampa.Arrow+   other-modules:+    -- Auxiliary (commonly used) types+    FRP.Yampa.Diagnostics     FRP.Yampa.InternalCore  test-suite hlint

@@ -0,0 +1,62 @@+{-# LANGUAGE Arrows                    #-}+{-# LANGUAGE FlexibleContexts          #-}+{-# LANGUAGE NoMonomorphismRestriction #-}++-- | Example of connecting the diagrams drawing library with Yampa.+--+-- Based on:+-- https://archives.haskell.org/projects.haskell.org/diagrams/gallery/VectorField.html+--+-- Install diagrams with Cairo support, together with Yampa:+--+-- cabal sandbox init+-- cabal install Yampa diagrams -fcairo+--+-- Compile in a sandbox with:+--+-- cabal exec -- ghc --make examples/Diagrams.hs+--+-- And run with:+--+-- ./examples/Diagrams -w 400 -h 400 -o output.gif++import Diagrams.Backend.Cairo.CmdLine+import Diagrams.Prelude+import FRP.Yampa                      hiding (norm, ( # ), (*^))++main = mainWith $ take 60 frames++frames :: [(Diagram B, Int)]+frames = zip ((embed sfVF $ deltaEncode 1 $ repeat ())) (repeat 1)++sfVF :: SF () (Diagram B)+sfVF = proc () -> do+  t <- time -< ()+  let diag = ( field t # translateY 0.05 # lc white+          <> ( square 3.5 # lw none # alignBL))+  returnA -< diag++field t = position $ zip points (arrows t)++locs   = [(x, y) | x <- [0.1, 0.3 .. 3.25], y <- [0.1, 0.3 .. 3.25]]++points = map p2 locs++vectorField t (x, y) = r2 (sin (t + y + 1), sin (t + x + 1))++arrows t = map (arrowAtPoint t) locs++arrowAtPoint t (x, y) = arrowAt' opts (p2 (x, y)) (sL *^ vf) # alignTL+  where+    vf   = vectorField t (x, y)+    m    = norm $ vectorField t (x, y)++    -- Head size is a function of the length of the vector+    -- as are tail size and shaft length.++    hs   = 0.02 * m+    sW   = 0.004 * m+    sL   = 0.05 + 0.1 * m+    opts = (with & arrowHead  .~ spike+                 & headLength .~ normalized hs+                 & shaftStyle %~ lwN sW)

@@ -11,116 +11,134 @@ -- Portability :  non-portable (GHC extensions) -- ----- Domain-specific language embedded in Haskell for programming hybrid (mixed--- discrete-time and continuous-time) systems. Yampa is based on the concepts--- of Functional Reactive Programming (FRP) and is structured using arrow--- combinators.+-- Domain-specific language embedded in Haskell for programming deterministic+-- hybrid (mixed discrete-time and continuous-time) systems. Yampa is based on+-- the concepts of Functional Reactive Programming (FRP) and is structured+-- using arrow combinators. ----- You can find examples, screenshots, tutorials and documentation here:+-- Yampa has been used to write professional Haskell cross-platform games for+-- iOS, Android, desktop and web. There is a library for testing Yampa+-- applications that allows you to use Temporal Logic and QuickCheck to test+-- your games. You can also use a time-travel debugger to connect to your+-- application running live and debug it step by step. --+-- __Documentation__+--+-- You can find many examples, tutorials and documentation here:+-- -- <https://github.com/ivanperez-keera/Yampa> -- -- <https://github.com/ivanperez-keera/Yampa/tree/master/examples> -- -- <https://wiki.haskell.org/Yampa> -------- Structuring a hybrid system in Yampa is done based on two main concepts:------ * Signal Functions: 'SF'. Yampa is based on the concept of Signal Functions,--- which are functions from a typed input signal to a typed output signal.--- Conceptually, signals are functions from Time to Value, where time are the--- real numbers and, computationally, a very dense approximation (Double) is--- used.------ * Events: 'Event'. Values that may or may not occur (and would probably--- occur rarely). It is often used for incoming network messages, mouse--- clicks, etc. Events are used as values carried by signals.------ A complete Yampa system is defined as one Signal Function from some--- type @a@ to a type @b@. The execution of this signal transformer--- with specific input can be accomplished by means of two functions:--- 'reactimate' (which needs an initialization action,--- an input sensing action and an actuation/consumer action and executes--- until explicitly stopped), and 'react' (which executes only one cycle).--------- Main Yampa modules:+-- __Yampa at a glance__ ----- * "FRP.Yampa"            -- This exports all FRP-related functions+-- A Yampa network is structured as a Signal Function: a pure transformation+-- from a time-varying input to that produces a time-varying output. The Yampa+-- language provides signal function primitives, as well as SF combinators.+-- Primitives and combinators guarantee that SFs are well-formed and efficient. ----- * "FRP.Yampa.Task"+-- For example, a game could take the changing mouse position (continuous-time+-- signal) and mouse clicks (discrete-time signal), combine them as part of+-- some game logic, and produce an animation with sound (continuously changing+-- picture). ----- Minimal Complete FRP Definition:+-- /Signal and SF separation/ ----- * "FRP.Yampa.Core"+-- To create a Yampa system, you need to think about three things: ----- Different FRP aspects:+-- * How to obtain the input signals coming into your system. This typically+-- requires polling some input device or consuming a queue of input events. ----- * "FRP.Yampa.Basic"+-- * How to consume the output signals produced by your system. This typically+-- requires taking output samples or chunks and rendering them or playing them. ----- * "FRP.Yampa.Conditional"+-- * How to transform the input signal into the output signal. This requires+-- thinking about the transformation applied as time progresses towards the+-- future, possinly switching from one transformation to another as the program+-- evolves. ----- * "FRP.Yampa.Delays"+-- The first two aspects lie outside Yampa, and they determine the backends+-- that your system uses. Yampa is backend-agnostic, and you can connect it to+-- SDL, SDL2, OpenGL, Gloss, Diagrams, HTML5 Canvas. In addition, you can use+-- it with any input device you want, and it has been used with Nintendo+-- wiimotes, Microsoft Kinects and LeapMotions. ----- * "FRP.Yampa.Event"+-- The last aspect is what defines Yampa as a language. You define a pure+-- Signal Function (@SF@) using primitives and combinators. You can find a+-- series of primitive SFs in "FRP.Yampa.Basic". For example, the function+-- 'constant' allows you to ignore the input signal and produce a constant+-- output, the function 'arr' allows you to apply a pure function to every+-- input value at every time, ignoring previous history. Signal Functions can+-- transform signals taking their history into account. For example, the+-- function 'integral' integrates the input signal. ----- * "FRP.Yampa.EventS"       -- Event consuming/producing SFs. To be renamed.+-- /Execution/ ----- * "FRP.Yampa.Hybrid"       -- Hybrid (discrete/continuous) SFs+-- The execution of this signal transformer with specific input can be+-- accomplished by means of two functions: 'reactimate' (which needs an+-- initialization action, an input sensing action and an actuation/consumer+-- action and executes until explicitly stopped), and 'react' (which executes+-- only one cycle). You can also use the function 'embed' to try your signal+-- functions with lists of input samples in GHCi. ----- * "FRP.Yampa.Integration"+-- For a simple example of an SDL application that creates a moving picture+-- around the mouse position, see: ----- * "FRP.Yampa.Loop"+-- https://github.com/ivanperez-keera/Yampa/blob/develop/examples/yampa-game/MainCircleMouse.hs ----- * "FRP.Yampa.Random"+-- /Hybrid systems/ ----- * "FRP.Yampa.Scan"+-- Signals can change in continuous or in discrete time (known as 'Event's).+-- Events represent values that may or may not occur (and would probably occur+-- rarely). It is often used for incoming network messages, mouse clicks, etc.+-- Events are used as values carried by signals.  The module "FRP.Yampa.Event"+-- allows you to manipulate events, the module "FRP.Yampa.EventS" deals with+-- event signal functions, and the "FRP.Yampa.Hybrid" allows you to go from a+-- continuous-time domain to a discrete domain, and vice-versa. ----- * "FRP.Yampa.Switches"+-- __Library Overview__ ----- * "FRP.Yampa.Time"+-- * Main Yampa module ----- * "FRP.Yampa.Simulation" -- Reactimation/evaluation+--     * "FRP.Yampa"            -- Exports all FRP-related functions ----- Internals:+-- * Different FRP aspects ----- * "FRP.Yampa.InternalCore" -- Module not exposed.+--     * "FRP.Yampa.Basic"        -- Primitive SFs ----- Geometry:+--     * "FRP.Yampa.Conditional"  -- Apply one SF or another depending on a condition ----- * "FRP.Yampa.Geometry"+--     * "FRP.Yampa.Delays"       -- Delay a signal ----- * "FRP.Yampa.AffineSpace"+--     * "FRP.Yampa.Event"        -- Event combinators ----- * "FRP.Yampa.VectorSpace"+--     * "FRP.Yampa.EventS"       -- Event Signal Functions ----- * "FRP.Yampa.Point2"+--     * "FRP.Yampa.Hybrid"       -- Continuous-time to Discrete-time combinators ----- * "FRP.Yampa.Point3"+--     * "FRP.Yampa.Integration"  -- Integration and derivation and sums ----- * "FRP.Yampa.Vector2"+--     * "FRP.Yampa.Loop"         -- Feedback loops ----- * "FRP.Yampa.Vector3"+--     * "FRP.Yampa.Random"       -- Random signals ----- Old legacy code:+--     * "FRP.Yampa.Scan"         -- Scanning or folding a signal ----- * "FRP.Yampa.Diagnostics"+--     * "FRP.Yampa.Switches"     -- Dynamically changing an SF based on the value of a signal ----- * "FRP.Yampa.Forceable"+--     * "FRP.Yampa.Task"         -- SFs that terminate and are followed by other SFs. ----- * "FRP.Yampa.Internals"  -- No longer in use+--     * "FRP.Yampa.Time"         -- Signals that represent time ----- * "FRP.Yampa.MergeableRecord"+-- * Execution ----- * "FRP.Yampa.Miscellany"+--     * "FRP.Yampa.Simulation" -- Reactimation/evaluation ----- * "FRP.Yampa.Utilities"+-- * Auxiliary modules ----- This will be the last version of Yampa to include mergeable records, point2--- and point3, vector2 and vector3, and other auxiliary definitions. The--- internals have now changed. Also, please let us know if you see any problems--- with the new project structure.+--     * "FRP.Yampa.Arrow" -- Arrow-generic functions  -- ToDo: --@@ -207,11 +225,6 @@ -----------------------------------------------------------------------------------------  module FRP.Yampa (-    -- Re-exported module, classes, and types-    module Control.Arrow,-    module FRP.Yampa.VectorSpace,-    RandomGen(..),-    Random(..),      -- * Basic definitions     Time,       -- [s] Both for time w.r.t. some reference and intervals.@@ -401,6 +414,9 @@                           --             (b,b) -> g -> SF a b     occasionally,         -- :: RandomGen g => g -> Time -> b -> SF a (Event b) +    RandomGen(..),+    Random(..),+     -- * Execution/simulation     -- ** Reactimation     reactimate,           -- :: IO a@@ -433,12 +449,14 @@      -- * Auxiliary definitions     --   Reverse function composition and arrow plumbing aids-    ( # ),                -- :: (a -> b) -> (b -> c) -> (a -> c),    infixl 9     dup,                  -- :: a -> (a,a) +    -- Re-exported module, classes, and types+    module Control.Arrow,+    module Data.VectorSpace,+ ) where -import Control.Arrow  import FRP.Yampa.InternalCore import FRP.Yampa.Basic@@ -449,13 +467,15 @@ import FRP.Yampa.Hybrid import FRP.Yampa.Integration import FRP.Yampa.Loop-import FRP.Yampa.Miscellany (( # ), dup)+import FRP.Yampa.Arrow (dup) import FRP.Yampa.Random import FRP.Yampa.Scan import FRP.Yampa.Simulation import FRP.Yampa.Switches import FRP.Yampa.Time-import FRP.Yampa.VectorSpace++import Control.Arrow+import Data.VectorSpace  -- Vim modeline -- vim:set tabstop=8 expandtab:

@@ -1,51 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.AffineSpace--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  non-portable (GHC extensions)------ Affine space type relation.-----------------------------------------------------------------------------------------------module FRP.Yampa.AffineSpace where--import FRP.Yampa.VectorSpace--infix 6 .+^, .-^, .-.---- Maybe origin should not be a class method, even though an origin--- can be assocoated with any affine space.--- Maybe distance should not be a class method, in which case the constraint--- on the coefficient space (a) could be Fractional (i.e., a Field), which--- seems closer to the mathematical definition of affine space, provided--- the constraint on the coefficient space for VectorSpace is also Fractional.---- | Affine Space type relation.------ An affine space is a set (type) @p@, and an associated vector space @v@ over--- a field @a@.-class (Floating a, VectorSpace v a) => AffineSpace p v a | p -> v, v -> a where--    -- | Origin of the affine space.-    origin   :: p--    -- | Addition of affine point and vector.-    (.+^)    :: p -> v -> p--    -- | Subtraction of affine point and vector.-    (.-^)    :: p -> v -> p-    p .-^ v = p .+^ (negateVector v)--    -- | Subtraction of two points in the affine space, giving a vector.-    (.-.)    :: p -> p -> v--    -- | Distance between two points in the affine space, same as the 'norm' of-    -- the vector they form (see '(.-.)'.-    distance :: p -> p -> a-    distance p1 p2 = norm (p1 .-. p2)

@@ -0,0 +1,55 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleInstances #-}+-----------------------------------------------------------------------------------------+-- |+-- Module      :  FRP.Yampa.Arrow+-- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003+-- License     :  BSD-style (see the LICENSE file in the distribution)+--+-- Maintainer  :  ivan.perez@keera.co.uk+-- Stability   :  provisional+-- Portability :  portable+--+-- Arrow helper functions.+--+-----------------------------------------------------------------------------------------++module FRP.Yampa.Arrow (+    -- * Arrow plumbing aids+    dup,        -- :: a -> (a,a)++    -- * Liftings+    arr2,       -- :: Arrow a => (b->c->d) -> a (b,c) d+    arr3,       -- :: Arrow a => (b->c->d->e) -> a (b,c,d) e+    arr4,       -- :: Arrow a => (b->c->d->e->f) -> a (b,c,d,e) f+    arr5,       -- :: Arrow a => (b->c->d->e->f->g) -> a (b,c,d,e,f) g+) where++import Control.Arrow+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative (Applicative(..))+#endif++-- * Arrow plumbing aids++-- | Duplicate an input.+dup :: a -> (a,a)+dup x = (x,x)++-- * Liftings++-- | Lift a binary function onto an arrow+arr2 :: Arrow a => (b -> c -> d) -> a (b, c) d+arr2 = arr . uncurry++-- | Lift a 3-ary function onto an arrow+arr3 :: Arrow a => (b -> c -> d -> e) -> a (b, c, d) e+arr3 = arr . \h (b, c, d) -> h b c d++-- | Lift a 4-ary function onto an arrow+arr4 :: Arrow a => (b -> c -> d -> e -> f) -> a (b, c, d, e) f+arr4 = arr . \h (b, c, d, e) -> h b c d e++-- | Lift a 5-ary function onto an arrow+arr5 :: Arrow a => (b -> c -> d -> e -> f -> g) -> a (b, c, d, e, f) g+arr5 = arr . \h (b, c, d, e, f) -> h b c d e f

@@ -1,48 +0,0 @@--- | Minimal FRP core.------   For documentation purposes only, to serve as a minimal FRP implementation.---   Based on Antony Courtney's thesis "Modeling User Interfaces in a---   Functional Language", page 48---   (see https://www.antonycourtney.com/pubs/ac-thesis.pdf, page 61).------ Notes:------ - While 'time' is defined as "core", it is not a primitive in Yampa, and it--- is actually defined as the 'integral' of @1@ over time.------ - This does not include 'derivative'.------ - This does not include parallel switching combinators (see--- 'FRP.Yampa.Switches').----module FRP.Yampa.Core-    (-    -- * Signal function-      SF--    -- * Stateless combinators-    , iPre-    , arr-    , (>>>)-    , first--    -- * Stateful combinators-    , loop-      -- | Instantly loops an SF, making the second output also the second-      -- input, using the fix combinator. This introduces a instant loop;-      -- without delays, that may lead to an infinite loop.-    , integral--    -- ** Switching upon certain events-    , Event(..)-    , switch--    -- ** Time-    -- | Note: The function 'time' is actually the 'integral' of @1@ over time.-    -- So, it's not really necessary.-    , Time-    , time-    )-   where--import FRP.Yampa

@@ -4,7 +4,7 @@ -- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License     :  BSD-style (see the LICENSE file in the distribution) ----- Maintainer  :  nilsson@cs.yale.edu+-- Maintainer  :  ivan.perez@keera.co.uk -- Stability   :  provisional -- Portability :  portable --

@@ -5,7 +5,7 @@ -- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License     :  BSD-style (see the LICENSE file in the distribution) ----- Maintainer  :  nilsson@cs.yale.edu+-- Maintainer  :  ivan.perez@keera.co.uk -- Stability   :  provisional -- Portability :  portable --@@ -92,7 +92,6 @@ import Control.DeepSeq (NFData(..))  import FRP.Yampa.Diagnostics-import FRP.Yampa.Forceable   infixl 8 `tag`, `attach`, `gate`@@ -188,13 +187,6 @@     -- 'NoEvent').     NoEvent <|> r = r     l       <|> _ = l----- | Forceable instance-instance Forceable a => Forceable (Event a) where-    -- | Force an event by evaluating its argument.-    force ea@NoEvent   = ea-    force ea@(Event a) = force a `seq` ea  -- | NFData instance instance NFData a => NFData (Event a) where

@@ -45,6 +45,7 @@     snap,               -- :: SF a (Event a)     snapAfter,          -- :: Time -> SF a (Event a)     sample,             -- :: Time -> SF a (Event a)+    sampleWindow,       -- :: Int -> Time -> SF a (Event [a])      -- * Repetition and switching     recur,              -- :: SF a (Event b) -> SF a (Event b)@@ -56,10 +57,11 @@  import FRP.Yampa.InternalCore (SF(..), sfConst, Time, SF'(..)) +import FRP.Yampa.Arrow import FRP.Yampa.Basic import FRP.Yampa.Diagnostics import FRP.Yampa.Event-import FRP.Yampa.Miscellany+import FRP.Yampa.Hybrid import FRP.Yampa.Scan import FRP.Yampa.Switches @@ -104,7 +106,7 @@ -- -- !!! cases like SFCpAXA. -- sfMkInv :: SF a b -> SF a b -- sfMkInv sf = SF {sfTF = ...}--- +-- --     sfMkInvAux :: SF' a b -> SF' a b --     sfMkInvAux sf@(SFArr _ _) = sf --     -- sfMkInvAux sf@(SFAcc _ _ _ _) = sf@@ -270,12 +272,12 @@ --     where --         tf0 NoEvent   = (noPendingEvent, NoEvent) --         tf0 (Event x) = (pendingEvents (-q) [] [] (-q) x, NoEvent)--- +-- --         noPendingEvent = SF' tf -- True --             where --                 tf _ NoEvent   = (noPendingEvent, NoEvent) --                 tf _ (Event x) = (pendingEvents (-q) [] [] (-q) x, NoEvent)--- +-- --         -- t_next is the present time w.r.t. the next scheduled event. --         -- t_last is the present time w.r.t. the last scheduled event. --         -- In the event queues, events are associated with their time@@ -288,13 +290,13 @@ --                         t_next' = t_next  + dt --                         t_last' = t_last  + dt --                         q'      = t_last' + q--- +-- --                 tf1 t_last' rqxs' t_next' --                     | t_next' >= 0 = --                         emitEventsScheduleNext t_last' rqxs' qxs t_next' [x] --                     | otherwise = --                         (pendingEvents t_last' rqxs' qxs t_next' x, NoEvent)--- +-- --         -- t_next is the present time w.r.t. the *scheduled* time of the --         -- event that is about to be emitted (i.e. >= 0). --         -- The time associated with any event at the head of the event@@ -518,6 +520,23 @@ -- | Sample a signal at regular intervals. sample :: Time -> SF a (Event a) sample p_ev = identity &&& repeatedly p_ev () >>^ \(a, e) -> e `tag` a++-- | Window sampling+--+-- First argument is the window length wl, second is the sampling interval t.+-- The output list should contain (min (truncate (T/t) wl)) samples, where+-- T is the time the signal function has been running. This requires some+-- care in case of sparse sampling. In case of sparse sampling, the+-- current input value is assumed to have been present at all points where+-- sampling was missed.+sampleWindow :: Int -> Time -> SF a (Event [a])+sampleWindow wl q =+    identity &&& afterEachCat (repeat (q, ()))+    >>> arr (\(a, e) -> fmap (map (const a)) e)+    >>> accumBy updateWindow []+    where+        updateWindow w as = drop (max (length w' - wl) 0) w'+            where w' = w ++ as  -- * Repetition and switching 

@@ -1,79 +0,0 @@--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Forceable--- Copyright   :  (c) Zhanyong Wan, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  portable------ Hyperstrict evaluation.--------------------------------------------------------------------------------------------module FRP.Yampa.Forceable- {-# DEPRECATED "Use DeepSeq instead" #-}- where---- | A deep strict evalaution class.-class Forceable a where-    -- | Evaluate completely.-    force :: a -> a---- | Deep strict evaluation for 'Int'.-instance Forceable Int where-  force = id---- | Deep strict evaluation for 'Integer'.-instance Forceable Integer where-  force = id---- | Deep strict evaluation for 'Double'.-instance Forceable Double where-  force = id---- | Deep strict evaluation for 'Float'.-instance Forceable Float where-  force = id---- | Deep strict evaluation for 'Bool'.-instance Forceable Bool where-  force = id---- | Deep strict evaluation for 'Char'.-instance Forceable Char where-  force = id---- | Deep strict evaluation for '()'.-instance Forceable () where-  force = id---- | Deep strict evaluation for pairs.-instance (Forceable a, Forceable b) => Forceable (a, b) where-  force p@(a, b) = force a `seq` force b `seq` p---- | Deep strict evaluation for triples.-instance (Forceable a, Forceable b, Forceable c) => Forceable (a, b, c) where-  force p@(a, b, c) = force a `seq` force b `seq` force c `seq` p---- | Deep strict evaluation for tuples of four elements.-instance (Forceable a, Forceable b, Forceable c, Forceable d) =>-         Forceable (a, b, c, d) where-  force p@(a, b, c, d) =-      force a `seq` force b `seq` force c `seq` force d `seq` p---- | Deep strict evaluation for tuples of five elements.-instance (Forceable a, Forceable b, Forceable c, Forceable d, Forceable e) =>-         Forceable (a, b, c, d, e) where-  force p@(a, b, c, d, e) =-      force a `seq` force b `seq` force c `seq` force d `seq` force e `seq` p---- | Deep strict evaluation for lists.-instance (Forceable a) => Forceable [a] where-  force nil@[] = nil-  force xs@(x:xs') = force x `seq` force xs' `seq` xs---- | Deep strict evaluation for 'Maybe'.-instance (Forceable a) => Forceable (Maybe a) where-  force mx@Nothing  = mx-  force mx@(Just x) = force x `seq` mx

@@ -1,28 +0,0 @@--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Geometry--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  non-portable (GHC extensions)------ Basic geometric abstractions.--------------------------------------------------------------------------------------------module FRP.Yampa.Geometry (-    module FRP.Yampa.VectorSpace,-    module FRP.Yampa.AffineSpace,-    module FRP.Yampa.Vector2,-    module FRP.Yampa.Vector3,-    module FRP.Yampa.Point2,-    module FRP.Yampa.Point3-) where--import FRP.Yampa.VectorSpace-import FRP.Yampa.AffineSpace-import FRP.Yampa.Vector2-import FRP.Yampa.Vector3-import FRP.Yampa.Point2-import FRP.Yampa.Point3

@@ -35,10 +35,11 @@ ) where  import Control.Arrow+import Data.VectorSpace+ import FRP.Yampa.Event import FRP.Yampa.Hybrid import FRP.Yampa.InternalCore (SF(..), SF'(..), DTime)-import FRP.Yampa.VectorSpace  ------------------------------------------------------------------------------ -- Integration and differentiation

@@ -183,7 +183,12 @@  ) where +#if __GLASGOW_HASKELL__ < 710+import Control.Applicative (Applicative(..))+#endif+ import Control.Arrow+ #if __GLASGOW_HASKELL__ >= 610 import qualified Control.Category (Category(..)) #endif@@ -361,7 +366,7 @@ --   This function returns an SF that, if there is an input, runs it --   through the given function and returns part of its output and, if not, --   returns the last known output.---   +-- --   The auxiliary function returns the value of the current output and --   the future held output, thus making it possible to have to distinct --   outputs for the present and the future.@@ -389,7 +394,7 @@ --   This function returns a running SF that, if there is an input, runs it --   through the given function and returns part of its output and, if not, --   returns the last known output.---   +-- --   The auxiliary function returns the value of the current output and --   the future held output, thus making it possible to have to distinct --   outputs for the present and the future.@@ -589,6 +594,17 @@ #else     (>>>)  = compPrim #endif++-- | Functor instance for applied SFs.+instance Functor (SF a) where+  fmap f = (>>> arr f)++-- | Applicative Functor instance (allows classic-frp style signals and+-- composition using applicative style).+instance Applicative (SF a) where+  pure x = arr (const x)+  f <*>  x  = (f &&& x) >>> arr (uncurry ($))+  -- * Lifting. 

@@ -1,24 +0,0 @@--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Internals--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  portable------ An interface giving access to some of the internal details of the Yampa--- implementation.------ Legacy, deprecated module.--------------------------------------------------------------------------------------------module FRP.Yampa.Internals-{-# DEPRECATED "Use FRP.Yampa instead" #-}- (-    Event(..)- )- where--import FRP.Yampa.Event

@@ -21,12 +21,12 @@   import Control.Arrow+import Data.VectorSpace  import FRP.Yampa.InternalCore (SF)  import FRP.Yampa.Integration import FRP.Yampa.Delays-import FRP.Yampa.VectorSpace  -- * Loops with guaranteed well-defined feedback 

@@ -1,89 +0,0 @@--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Miscellany--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  portable------ Framework for record merging.------ MergeableRecord is intended to be a super class for classes providing--- update operations on records. The ADT induced by such a set of operations--- can be considered a "mergeable record", which can be merged into larger--- mergeable records essentially by function composition. Finalization turns--- a mergeable record into a record.------ Typical use:------ Given------ >  data Foo = Foo {l1 :: T1, l2 :: T2}------ one define a mergeable record type (MR Foo) by the following instance:------ @---   instance MergeableRecord Foo where---       mrDefault = Foo {l1 = v1_dflt, l2 = v2_dflt}--- @------ Typically, one would also provide definitions for setting the fields,--- possibly (but not necessarily) overloaded:------ @---   instance HasL1 Foo where---       setL1 v = mrMake (\foo -> foo {l1 = v})--- @------ Now Foo records can be created as follows:------ @---   let foo1 = setL1 v1---   ...---   let foo2 = setL2 v2 ~+~ foo1---   ...---   let foo<N> = setL1 vN ~+~ foo<N-1>---   let fooFinal = mrFinalize foo<N>--- @--------------------------------------------------------------------------------------------module FRP.Yampa.MergeableRecord- {-# DEPRECATED "No longer supported." #-}- (-    MergeableRecord(..),-    MR,                 -- Abstract-    mrMake,-    (~+~),-    mrMerge,-    mrFinalize- )- where---- | Superclass providing operations on records. Record operations can be--- merged (composed). To obtain a record from a sequence of merging operations--- (see 'mrFinalize'), one needs only to provide an initial value, or--- 'mrDefault'.-class MergeableRecord a where-    mrDefault :: a---- | Type constructor for mergeable records.-newtype MR a = MR (a -> a)---- | Construction of a mergeable record.-mrMake :: MergeableRecord a => (a -> a) -> MR a-mrMake f = (MR f)---- | Merge two mergeable records. Left "overrides" in case of conflict.-(~+~) :: MergeableRecord a => MR a -> MR a -> MR a-(MR f1) ~+~ (MR f2) = MR (f1 . f2)---- | Merge two mergeable records. Left "overrides" in case of conflict.--- Synonym for '~+~'.-mrMerge :: MergeableRecord a => MR a -> MR a -> MR a-mrMerge = (~+~)---- | Finalization: turn a mergeable record into a record.-mrFinalize :: MergeableRecord a => MR a -> a-mrFinalize (MR f) = f mrDefault

@@ -1,211 +0,0 @@--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Miscellany--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  portable------ Collection of entities that really should be part of Haskell base, other packages,--- or simply have no better home.-----------------------------------------------------------------------------------------------module FRP.Yampa.Miscellany (-    -- * Reverse function composition-    ( # ),      -- :: (a -> b) -> (b -> c) -> (a -> c), infixl 9--    -- * Arrow plumbing aids-    dup,        -- :: a -> (a,a)--    -- * Maps over lists of pairs-    mapFst,     -- :: (a -> b) -> [(a,c)] -> [(b,c)]-    mapSnd,     -- :: (a -> b) -> [(c,a)] -> [(c,b)]--    -- * Generalized tuple selectors-    sel3_1, sel3_2, sel3_3,-    sel4_1, sel4_2, sel4_3, sel4_4,-    sel5_1, sel5_2, sel5_3, sel5_4, sel5_5,--    -- * Floating point utilities-    fDiv,       -- :: (RealFrac a, Integral b) => a -> a -> b-    fMod,       -- :: RealFrac a => a -> a -> a-    fDivMod,    -- :: (RealFrac a, Integral b) => a -> a -> (b, a)--    -- * Liftings-    arr2,       -- :: Arrow a => (b->c->d) -> a (b,c) d-    arr3,       -- :: Arrow a => (b->c->d->e) -> a (b,c,d) e-    arr4,       -- :: Arrow a => (b->c->d->e->f) -> a (b,c,d,e) f-    arr5,       -- :: Arrow a => (b->c->d->e->f->g) -> a (b,c,d,e,f) g-    lift0,      -- :: Arrow a => c -> a b c-    lift1,      -- :: Arrow a => (c->d) -> (a b c->a b d)-    lift2,      -- :: Arrow a => (c->d->e) -> (a b c->a b d->a b e)-    lift3,      -- :: Arrow a => (c->d->e->f) -> (a b c-> ... ->a b f)-    lift4,      -- :: Arrow a => (c->d->e->f->g) -> (a b c->...->a b g)-    lift5,      -- :: Arrow a => (c->d->e->f->g->h)->(a b c->...a b h)-) where--import Control.Arrow--infixl 9 #-infixl 7 `fDiv`, `fMod`---- | Reverse function composition---- !!! Reverse function composition should go.--- !!! Better to use <<< and >>> for, respectively,--- !!! function composition and reverse function composition.--{-# DEPRECATED (#) "Use Control.Arrow.(>>>) and Control.Arrow.(<<<)." #-}-( # ) :: (a -> b) -> (b -> c) -> (a -> c)-f # g = g . f------------------------------------------------------------------------------------ Arrow plumbing aids---- | Duplicate an input.-dup :: a -> (a,a)-dup x = (x,x)----------------------------------------------------------------------------------- Maps over lists of pairs----------------------------------------------------------------------------------- | Map a function over the first component of pairs in a list.-{-# DEPRECATED mapFst "mapFst is not used by Yampa and will be removed from the next release" #-}-mapFst :: (a -> b) -> [(a,c)] -> [(b,c)]-mapFst f = map (\(x,y) -> (f x, y))---- | Map a function over the second component of pairs in a list.-{-# DEPRECATED mapSnd "mapSnd is not used by Yampa and will be removed from the next release" #-}-mapSnd :: (a -> b) -> [(c,a)] -> [(c,b)]-mapSnd f = map (\(x,y) -> (x, f y))------------------------------------------------------------------------------------ Generalized tuple selectors---------------------------------------------------------------------------------{-# DEPRECATED sel3_1, sel3_2, sel3_3 "Use the tuple package instead." #-}--- Triples---- | Select the first component of a triple.-sel3_1 :: (a, b, c) -> a-sel3_1 (x,_,_) = x---- | Select the second component of a triple.-sel3_2 :: (a, b, c) -> b-sel3_2 (_,x,_) = x---- | Select the third component of a triple.-sel3_3 :: (a, b, c) -> c-sel3_3 (_,_,x) = x---{-# DEPRECATED sel4_1, sel4_2, sel4_3, sel4_4 "Use the tuple package instead." #-}--- 4-tuples--- | Select the first component of a 4-element tuple.-sel4_1 :: (a, b, c, d) -> a-sel4_1 (x,_,_,_) = x--- | Select the second component of a 4-element tuple.-sel4_2 :: (a, b, c, d) -> b-sel4_2 (_,x,_,_) = x--- | Select the third component of a 4-element tuple.-sel4_3 :: (a, b, c, d) -> c-sel4_3 (_,_,x,_) = x--- | Select the fourth component of a 4-element tuple.-sel4_4 :: (a, b, c, d) -> d-sel4_4 (_,_,_,x) = x----- 5-tuples--{-# DEPRECATED sel5_1, sel5_2, sel5_3, sel5_4, sel5_5 "Use the tuple package instead." #-}--- | Select the first component of a 5-element tuple.-sel5_1 :: (a, b, c, d, e) -> a-sel5_1 (x,_,_,_,_) = x--- | Select the second component of a 5-element tuple.-sel5_2 :: (a, b, c, d, e) -> b-sel5_2 (_,x,_,_,_) = x--- | Select the third component of a 5-element tuple.-sel5_3 :: (a, b, c, d, e) -> c-sel5_3 (_,_,x,_,_) = x--- | Select the fourth component of a 5-element tuple.-sel5_4 :: (a, b, c, d, e) -> d-sel5_4 (_,_,_,x,_) = x--- | Select the fifth component of a 5-element tuple.-sel5_5 :: (a, b, c, d, e) -> e-sel5_5 (_,_,_,_,x) = x------------------------------------------------------------------------------------ Floating point utilities----------------------------------------------------------------------------------- Floating-point div and modulo operators.--{-# DEPRECATED fDiv, fMod, fDivMod "These are not used by Yampa and will be removed." #-}--- | Floating-point integer division.-fDiv :: (RealFrac a) => a -> a -> Integer-fDiv x y = fst (fDivMod x y)---- | Floating-point modulo.-fMod :: (RealFrac a) => a -> a -> a-fMod x y = snd (fDivMod x y)---- | Floating-point integer division and modulo.-fDivMod :: (RealFrac a) => a -> a -> (Integer, a)-fDivMod x y = (q, r)-    where-        q = (floor (x/y))-        r = x - fromIntegral q * y---- * Arrows---- ** Liftings---- | Lift a binary function onto an arrow-arr2 :: Arrow a => (b -> c -> d) -> a (b, c) d-arr2 = arr . uncurry---- | Lift a 3-ary function onto an arrow-arr3 :: Arrow a => (b -> c -> d -> e) -> a (b, c, d) e-arr3 = arr . \h (b, c, d) -> h b c d---- | Lift a 4-ary function onto an arrow-arr4 :: Arrow a => (b -> c -> d -> e -> f) -> a (b, c, d, e) f-arr4 = arr . \h (b, c, d, e) -> h b c d e---- | Lift a 5-ary function onto an arrow-arr5 :: Arrow a => (b -> c -> d -> e -> f -> g) -> a (b, c, d, e, f) g-arr5 = arr . \h (b, c, d, e, f) -> h b c d e f---- | Lift an 0-ary function onto an arrow------ If there was an @arr0@ function, this would be a synonym.-lift0 :: Arrow a => c -> a b c-lift0 c = arr (const  c)---- | Lift a function into a function between arrows.-lift1 :: Arrow a => (c -> d) -> (a b c -> a b d)-lift1 f = \a -> a >>> arr f---- | Lift a binary function into a function between arrows.-lift2 :: Arrow a => (c -> d -> e) -> (a b c -> a b d -> a b e)-lift2 f = \a1 a2 -> a1 &&& a2 >>> arr2 f---- | Lift a 3-ary function into a function between arrows.-lift3 :: Arrow a => (c -> d -> e -> f) -> (a b c -> a b d -> a b e -> a b f)-lift3 f = \a1 a2 a3 -> (lift2 f) a1 a2 &&& a3 >>> arr2 ($)---- | Lift a 4-ary function into a function between arrows.-lift4 :: Arrow a => (c->d->e->f->g) -> (a b c->a b d->a b e->a b f->a b g)-lift4 f = \a1 a2 a3 a4 -> (lift3 f) a1 a2 a3 &&& a4 >>> arr2 ($)---- | Lift a 5-ary function into a function between arrows.-lift5 :: Arrow a =>-    (c->d->e->f->g->h) -> (a b c->a b d->a b e->a b f->a b g->a b h)-lift5 f = \a1 a2 a3 a4 a5 ->(lift4 f) a1 a2 a3 a4 &&& a5 >>> arr2 ($)

@@ -1,59 +0,0 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Point2--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  non-portable (GHC extensions)------ 2D point abstraction (R^2).-----------------------------------------------------------------------------------------------module FRP.Yampa.Point2 (-    Point2(..), -- Non-abstract, instance of AffineSpace-    point2X,    -- :: RealFloat a => Point2 a -> a-    point2Y     -- :: RealFloat a => Point2 a -> a-) where--import FRP.Yampa.VectorSpace ()-import FRP.Yampa.AffineSpace-import FRP.Yampa.Vector2-import FRP.Yampa.Forceable---- * 2D point, constructors and selectors---- | 2D point.-data Point2 a = RealFloat a => Point2 !a !a--deriving instance Eq a => Eq (Point2 a)--deriving instance Show a => Show (Point2 a)---- | X coordinate of a 2D point.-point2X :: RealFloat a => Point2 a -> a-point2X (Point2 x _) = x---- | Y coordinate of a 2D point.-point2Y :: RealFloat a => Point2 a -> a-point2Y (Point2 _ y) = y---- * Affine space instance--instance RealFloat a => AffineSpace (Point2 a) (Vector2 a) a where-    origin = Point2 0 0--    (Point2 x y) .+^ v = Point2 (x + vector2X v) (y + vector2Y v)--    (Point2 x y) .-^ v = Point2 (x - vector2X v) (y - vector2Y v)--    (Point2 x1 y1) .-. (Point2 x2 y2) = vector2 (x1 - x2) (y1 - y2)---- * Forceable instance--instance RealFloat a => Forceable (Point2 a) where-     force = id

@@ -1,67 +0,0 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Point3--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  non-portable (GHC extensions)------ 3D point abstraction (R^3).-----------------------------------------------------------------------------------------------module FRP.Yampa.Point3 (-    Point3(..), -- Non-abstract, instance of AffineSpace-    point3X,    -- :: RealFloat a => Point3 a -> a-    point3Y,    -- :: RealFloat a => Point3 a -> a-    point3Z     -- :: RealFloat a => Point3 a -> a-) where--import FRP.Yampa.VectorSpace ()-import FRP.Yampa.AffineSpace-import FRP.Yampa.Vector3-import FRP.Yampa.Forceable---- * 3D point, constructors and selectors---- | 3D point.-data Point3 a = RealFloat a => Point3 !a !a !a--deriving instance Eq a => Eq (Point3 a)--deriving instance Show a => Show (Point3 a)---- | X coodinate of a 3D point.-point3X :: RealFloat a => Point3 a -> a-point3X (Point3 x _ _) = x---- | Y coodinate of a 3D point.-point3Y :: RealFloat a => Point3 a -> a-point3Y (Point3 _ y _) = y---- | Z coodinate of a 3D point.-point3Z :: RealFloat a => Point3 a -> a-point3Z (Point3 _ _ z) = z---- * Affine space instance--instance RealFloat a => AffineSpace (Point3 a) (Vector3 a) a where-    origin = Point3 0 0 0--    (Point3 x y z) .+^ v =-        Point3 (x + vector3X v) (y + vector3Y v) (z + vector3Z v)--    (Point3 x y z) .-^ v =-        Point3 (x - vector3X v) (y - vector3Y v) (z - vector3Z v)--    (Point3 x1 y1 z1) .-. (Point3 x2 y2 z2) =-        vector3 (x1 - x2) (y1 - y2) (z1 - z2)---- * Forceable instance--instance RealFloat a => Forceable (Point3 a) where-     force = id

@@ -5,7 +5,7 @@ -- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003 -- License     :  BSD-style (see the LICENSE file in the distribution) ----- Maintainer  :  nilsson@cs.yale.edu+-- Maintainer  :  ivan.perez@keera.co.uk -- Stability   :  provisional -- Portability :  non-portable (GHC extensions) --@@ -24,13 +24,8 @@     snapT,       -- :: Task a b a     timeOut,     -- :: Task a b c -> Time -> Task a b (Maybe c)     abortWhen,   -- :: Task a b c -> SF a (Event d) -> Task a b (Either c d)-    repeatUntil, -- :: Monad m => m a -> (a -> Bool) -> m a-    for,         -- :: Monad m => a -> (a -> a) -> (a -> Bool) -> m b -> m ()-    forAll,      -- :: Monad m => [a] -> (a -> m b) -> m ()-    forEver      -- :: Monad m => m a -> m b ) where -import Control.Monad (when, forM_) #if __GLASGOW_HASKELL__ < 710 import Control.Applicative (Applicative(..)) #endif@@ -39,7 +34,7 @@ import FRP.Yampa.EventS (snap) import FRP.Yampa.Diagnostics -infixl 0 `timeOut`, `abortWhen`, `repeatUntil`+infixl 0 `timeOut`, `abortWhen`   -- * The Task type@@ -198,33 +193,3 @@ tk `abortWhen` est = mkTask ((taskToSF tk &&& est) >>> arr aux)     where         aux ((b, ec), ed) = (b, (lMerge (fmap Left ec) (fmap Right ed)))------------------------------------------------------------------------------------ * Loops----------------------------------------------------------------------------------- These are general monadic combinators. Maybe they don't really belong here.---- | Repeat m until result satisfies the predicate p-repeatUntil :: Monad m => m a -> (a -> Bool) -> m a-m `repeatUntil` p = m >>= \x -> if not (p x) then repeatUntil m p else return x----- | C-style for-loop.------ Example:------ >>> for 0 (+1) (>=10) ...-for :: Monad m => a -> (a -> a) -> (a -> Bool) -> m b -> m ()-for i f p m = when (p i) $ m >> for (f i) f p m----- | Perform the monadic operation for each element in the list.-forAll :: Monad m => [a] -> (a -> m b) -> m ()-forAll = forM_----- | Repeat m for ever.-forEver :: Monad m => m a -> m b-forEver m = m >> forEver m

@@ -1,62 +0,0 @@--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Utilities--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  portable------ Derived utility definitions.------- ToDo:------ - Possibly add---       impulse :: VectorSpace a k => a -> Event a---   But to do that, we need access to Event, which we currently do not have.------ - The general arrow utilities should be moved to a module---   FRP.Yampa.Utilities.------ - I'm not sure structuring the Yampa \"core\" according to what is---   core functionality and what's not is all that useful. There are---   many cases where we want to implement combinators that fairly---   easily could be implemented in terms of others as primitives simply---   because we expect that that implementation is going to be much more---   efficient, and that the combinators are used sufficiently often to---   warrant doing this. E.g. 'switch' should be a primitive, even though---   it could be derived from 'pSwitch'.------ - Reconsider 'recur'. If an event source has an immediate occurrence,---   we'll get into a loop. For example: recur now. Maybe suppress---   initial occurrences? Initial occurrences are rather pointless in this---   case anyway.--------------------------------------------------------------------------------------------module FRP.Yampa.Utilities (sampleWindow) where--import Control.Arrow--import FRP.Yampa.Basic-import FRP.Yampa.Core-import FRP.Yampa.EventS-import FRP.Yampa.Hybrid---- | Window sampling------ First argument is the window length wl, second is the sampling interval t.--- The output list should contain (min (truncate (T/t) wl)) samples, where--- T is the time the signal function has been running. This requires some--- care in case of sparse sampling. In case of sparse sampling, the--- current input value is assumed to have been present at all points where--- sampling was missed.-sampleWindow :: Int -> Time -> SF a (Event [a])-sampleWindow wl q =-    identity &&& afterEachCat (repeat (q, ()))-    >>> arr (\(a, e) -> fmap (map (const a)) e)-    >>> accumBy updateWindow []-    where-        updateWindow w as = drop (max (length w' - wl) 0) w'-            where w' = w ++ as

@@ -1,108 +0,0 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Vector2--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  non-portable (GHC extensions)------ 2D vector abstraction (R^2).-----------------------------------------------------------------------------------------------module FRP.Yampa.Vector2 (-    Vector2,            -- Abstract, instance of VectorSpace-    vector2,            -- :: RealFloat a => a -> a -> Vector2 a-    vector2X,           -- :: RealFloat a => Vector2 a -> a-    vector2Y,           -- :: RealFloat a => Vector2 a -> a-    vector2XY,          -- :: RealFloat a => Vector2 a -> (a, a)-    vector2Polar,       -- :: RealFloat a => a -> a -> Vector2 a-    vector2Rho,         -- :: RealFloat a => Vector2 a -> a-    vector2Theta,       -- :: RealFloat a => Vector2 a -> a-    vector2RhoTheta,    -- :: RealFloat a => Vector2 a -> (a, a)-    vector2Rotate       -- :: RealFloat a => a -> Vector2 a -> Vector2 a-) where--import FRP.Yampa.VectorSpace-import FRP.Yampa.Forceable---- * 2D vector, constructors and selectors---- | 2D Vector.---- Restrict coefficient space to RealFloat (rather than Floating) for now.--- While unclear if a complex coefficient space would be useful (and if the--- result really would be a 2d vector), the only thing causing trouble is the--- use of atan2 in vector2Theta. Maybe atan2 can be generalized?--data Vector2 a = RealFloat a => Vector2 !a !a--deriving instance Eq a => Eq (Vector2 a)--deriving instance Show a => Show (Vector2 a)---- | Creates a 2D vector from the cartesian coordinates.-vector2 :: RealFloat a => a -> a -> Vector2 a-vector2 = Vector2---- | X cartesian coordinate.-vector2X :: RealFloat a => Vector2 a -> a-vector2X (Vector2 x _) = x---- | Y cartesian coordinate.-vector2Y :: RealFloat a => Vector2 a -> a-vector2Y (Vector2 _ y) = y---- | Returns a vector's cartesian coordinates.-vector2XY :: RealFloat a => Vector2 a -> (a, a)-vector2XY (Vector2 x y) = (x, y)---- | Creates a 2D vector from the polar coordinates.-vector2Polar :: RealFloat a => a -> a -> Vector2 a-vector2Polar rho theta = Vector2 (rho * cos theta) (rho * sin theta)---- | Calculates the vector's radial distance (magnitude).-vector2Rho :: RealFloat a => Vector2 a -> a-vector2Rho (Vector2 x y) = sqrt (x * x + y * y)---- | Calculates the vector's azimuth (angle).-vector2Theta :: RealFloat a => Vector2 a -> a-vector2Theta (Vector2 x y) = atan2 y x---- | Polar coordinate representation of a 2D vector.-vector2RhoTheta :: RealFloat a => Vector2 a -> (a, a)-vector2RhoTheta v = (vector2Rho v, vector2Theta v)---- * Vector space instance--instance RealFloat a => VectorSpace (Vector2 a) a where-    zeroVector = Vector2 0 0--    a *^ (Vector2 x y) = Vector2 (a * x) (a * y)--    (Vector2 x y) ^/ a = Vector2 (x / a) (y / a)--    negateVector (Vector2 x y) = (Vector2 (-x) (-y))--    (Vector2 x1 y1) ^+^ (Vector2 x2 y2) = Vector2 (x1 + x2) (y1 + y2)--    (Vector2 x1 y1) ^-^ (Vector2 x2 y2) = Vector2 (x1 - x2) (y1 - y2)--    (Vector2 x1 y1) `dot` (Vector2 x2 y2) = x1 * x2 + y1 * y2----- * Additional operations---- | Rotates a vector with a given angle.-vector2Rotate :: RealFloat a => a -> Vector2 a -> Vector2 a-vector2Rotate theta' v = vector2Polar (vector2Rho v) (vector2Theta v + theta')----- * Forceable instance--instance RealFloat a => Forceable (Vector2 a) where-     force = id

@@ -1,127 +0,0 @@-{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}-{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleInstances, StandaloneDeriving #-}--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.Vector3--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  non-portable (GHC extensions)------ 3D vector abstraction (R^3).-----------------------------------------------------------------------------------------------module FRP.Yampa.Vector3 (-    Vector3,            -- Abstract, instance of VectorSpace-    vector3,            -- :: RealFloat a => a -> a -> a -> Vector3 a-    vector3X,           -- :: RealFloat a => Vector3 a -> a-    vector3Y,           -- :: RealFloat a => Vector3 a -> a-    vector3Z,           -- :: RealFloat a => Vector3 a -> a-    vector3XYZ,         -- :: RealFloat a => Vector3 a -> (a, a, a)-    vector3Spherical,   -- :: RealFloat a => a -> a -> a -> Vector3 a-    vector3Rho,         -- :: RealFloat a => Vector3 a -> a-    vector3Theta,       -- :: RealFloat a => Vector3 a -> a-    vector3Phi,         -- :: RealFloat a => Vector3 a -> a-    vector3RhoThetaPhi, -- :: RealFloat a => Vector3 a -> (a, a, a)-    vector3Rotate       -- :: RealFloat a => a -> a -> Vector3 a -> Vector3 a-) where--import FRP.Yampa.VectorSpace-import FRP.Yampa.Forceable---- * 3D vector, constructors and selectors----- | 3D Vector.---- Restrict coefficient space to RealFloat (rather than Floating) for now.--- While unclear if a complex coefficient space would be useful (and if the--- result really would be a 3d vector), the only thing causing trouble is the--- use of atan2 in vector3Theta and vector3Phi. Maybe atan2 can be generalized?--data Vector3 a = RealFloat a => Vector3 !a !a !a--deriving instance Eq a => Eq (Vector3 a)--deriving instance Show a => Show (Vector3 a)---- | Creates a 3D vector from the cartesian coordinates.-vector3 :: RealFloat a => a -> a -> a -> Vector3 a-vector3 = Vector3---- | X cartesian coordinate.-vector3X :: RealFloat a => Vector3 a -> a-vector3X (Vector3 x _ _) = x---- | Y cartesian coordinate.-vector3Y :: RealFloat a => Vector3 a -> a-vector3Y (Vector3 _ y _) = y---- | Z cartesian coordinate.-vector3Z :: RealFloat a => Vector3 a -> a-vector3Z (Vector3 _ _ z) = z---- | Returns a vector's cartesian coordinates.-vector3XYZ :: RealFloat a => Vector3 a -> (a, a, a)-vector3XYZ (Vector3 x y z) = (x, y, z)---- | Creates a 3D vector from the spherical coordinates.-vector3Spherical :: RealFloat a => a -> a -> a -> Vector3 a-vector3Spherical rho theta phi =-    Vector3 (rhoSinPhi * cos theta) (rhoSinPhi * sin theta) (rho * cos phi)-    where-        rhoSinPhi = rho * sin phi---- | Calculates the vector's radial distance.-vector3Rho :: RealFloat a => Vector3 a -> a-vector3Rho (Vector3 x y z) = sqrt (x * x + y * y + z * z)---- | Calculates the vector's azimuth.-vector3Theta :: RealFloat a => Vector3 a -> a-vector3Theta (Vector3 x y _) = atan2 y x---- | Calculates the vector's inclination.-vector3Phi :: RealFloat a => Vector3 a -> a-vector3Phi v@(Vector3 _ _ z) = acos (z / vector3Rho v)---- | Spherical coordinate representation of a 3D vector.-vector3RhoThetaPhi :: RealFloat a => Vector3 a -> (a, a, a)-vector3RhoThetaPhi (Vector3 x y z) = (rho, theta, phi)-    where-        rho   = sqrt (x * x + y * y + z * z)-        theta = atan2 y x-        phi   = acos (z / rho)---- * Vector space instance--instance RealFloat a => VectorSpace (Vector3 a) a where-    zeroVector = Vector3 0 0 0--    a *^ (Vector3 x y z) = Vector3 (a * x) (a * y) (a * z)--    (Vector3 x y z) ^/ a = Vector3 (x / a) (y / a) (z / a)--    negateVector (Vector3 x y z) = (Vector3 (-x) (-y) (-z))--    (Vector3 x1 y1 z1) ^+^ (Vector3 x2 y2 z2) = Vector3 (x1+x2) (y1+y2) (z1+z2)--    (Vector3 x1 y1 z1) ^-^ (Vector3 x2 y2 z2) = Vector3 (x1-x2) (y1-y2) (z1-z2)--    (Vector3 x1 y1 z1) `dot` (Vector3 x2 y2 z2) = x1 * x2 + y1 * y2 + z1 * z2---- * Additional operations---- | Rotates a vector with a given polar and azimuthal angles.-vector3Rotate :: RealFloat a => a -> a -> Vector3 a -> Vector3 a-vector3Rotate theta' phi' v =-    vector3Spherical (vector3Rho v)-                     (vector3Theta v + theta')-                     (vector3Phi v + phi')---- * Forceable instance--instance RealFloat a => Forceable (Vector3 a) where-     force = id

@@ -1,178 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}--------------------------------------------------------------------------------------------- |--- Module      :  FRP.Yampa.VectorSpace--- Copyright   :  (c) Antony Courtney and Henrik Nilsson, Yale University, 2003--- License     :  BSD-style (see the LICENSE file in the distribution)------ Maintainer  :  nilsson@cs.yale.edu--- Stability   :  provisional--- Portability :  non-portable (GHC extensions)------ Vector space type relation and basic instances.--------------------------------------------------------------------------------------------module FRP.Yampa.VectorSpace where--infixr *^-infixl ^/-infix 7 `dot`-infixl 6 ^+^, ^-^---- Maybe norm and normalize should not be class methods, in which case--- the constraint on the coefficient space (a) should (or, at least, could)--- be Fractional (roughly a Field) rather than Floating.---- | Vector space type relation.------   A vector space is a set (type) closed under addition and multiplication by---   a scalar. The type of the scalar is the /field/ of the vector space, and---   it is said that @v@ is a vector space over @a@.------   The encoding uses a type class |VectorSpace| @v a@, where @v@ represents---   the type of the vectors and @a@ represents the types of the scalars.--class (Eq a, Floating a) => VectorSpace v a | v -> a where-    -- | Vector with no magnitude (unit for addition).-    zeroVector :: v--    -- | Multiplication by a scalar.-    (*^) :: a -> v -> v--    -- | Division by a scalar.-    (^/) :: v -> a -> v-    v ^/ a = (1/a) *^ v--    -- | Vector addition-    (^+^) :: v -> v -> v--    -- | Vector subtraction-    (^-^) :: v -> v -> v-    v1 ^-^ v2 = v1 ^+^ negateVector v2--    -- | Vector negation. Addition with a negated vector should be-    --   same as subtraction.-    negateVector :: v -> v-    negateVector v = (-1) *^ v--    -- | Dot product (also known as scalar or inner product).-    ---    -- For two vectors, mathematically represented as @a = a1,a2,...,an@ and @b-    -- = b1,b2,...,bn@, the dot product is @a . b = a1*b1 + a2*b2 + ... +-    -- an*bn@.-    ---    -- Some properties are derived from this. The dot product of a vector with-    -- itself is the square of its magnitude ('norm'), and the dot product of-    -- two orthogonal vectors is zero.-    dot :: v -> v -> a--    -- | Vector's norm (also known as magnitude).-    ---    -- For a vector represented mathematically as @a = a1,a2,...,an@, the norm-    -- is the square root of @a1^2 + a2^2 + ... + an^2@.-    norm :: v -> a-    norm v = sqrt (v `dot` v)--    -- | Return a vector with the same origin and orientation (angle), but such-    -- that the norm is one (the unit for multiplication by a scalar).-    normalize    :: v -> v-    normalize v = if nv /= 0 then v ^/ nv else error "normalize: zero vector"-        where nv = norm v---- | Vector space instance for 'Float's, with 'Float' scalars.-instance VectorSpace Float Float where-    zeroVector = 0--    a *^ x = a * x--    x ^/ a = x / a--    negateVector x = (-x)--    x1 ^+^ x2 = x1 + x2--    x1 ^-^ x2 = x1 - x2--    x1 `dot` x2 = x1 * x2---- | Vector space instance for 'Double's, with 'Double' scalars.-instance VectorSpace Double Double where-    zeroVector = 0--    a *^ x = a * x--    x ^/ a = x / a--    negateVector x = (-x)--    x1 ^+^ x2 = x1 + x2--    x1 ^-^ x2 = x1 - x2--    x1 `dot` x2 = x1 * x2----- | Vector space instance for pairs of 'Floating' point numbers.-instance (Eq a, Floating a) => VectorSpace (a,a) a where-    zeroVector = (0,0)--    a *^ (x,y) = (a * x, a * y)--    (x,y) ^/ a = (x / a, y / a)--    negateVector (x,y) = (-x, -y)--    (x1,y1) ^+^ (x2,y2) = (x1 + x2, y1 + y2)--    (x1,y1) ^-^ (x2,y2) = (x1 - x2, y1 - y2)--    (x1,y1) `dot` (x2,y2) = x1 * x2 + y1 * y2---- | Vector space instance for triplets of 'Floating' point numbers.-instance (Eq a, Floating a) => VectorSpace (a,a,a) a where-    zeroVector = (0,0,0)--    a *^ (x,y,z) = (a * x, a * y, a * z)--    (x,y,z) ^/ a = (x / a, y / a, z / a)--    negateVector (x,y,z) = (-x, -y, -z)--    (x1,y1,z1) ^+^ (x2,y2,z2) = (x1+x2, y1+y2, z1+z2)--    (x1,y1,z1) ^-^ (x2,y2,z2) = (x1-x2, y1-y2, z1-z2)--    (x1,y1,z1) `dot` (x2,y2,z2) = x1 * x2 + y1 * y2 + z1 * z2---- | Vector space instance for tuples with four 'Floating' point numbers.-instance (Eq a, Floating a) => VectorSpace (a,a,a,a) a where-    zeroVector = (0,0,0,0)--    a *^ (x,y,z,u) = (a * x, a * y, a * z, a * u)--    (x,y,z,u) ^/ a = (x / a, y / a, z / a, u / a)--    negateVector (x,y,z,u) = (-x, -y, -z, -u)--    (x1,y1,z1,u1) ^+^ (x2,y2,z2,u2) = (x1+x2, y1+y2, z1+z2, u1+u2)--    (x1,y1,z1,u1) ^-^ (x2,y2,z2,u2) = (x1-x2, y1-y2, z1-z2, u1-u2)--    (x1,y1,z1,u1) `dot` (x2,y2,z2,u2) = x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2---- | Vector space instance for tuples with five 'Floating' point numbers.-instance (Eq a, Floating a) => VectorSpace (a,a,a,a,a) a where-    zeroVector = (0,0,0,0,0)--    a *^ (x,y,z,u,v) = (a * x, a * y, a * z, a * u, a * v)--    (x,y,z,u,v) ^/ a = (x / a, y / a, z / a, u / a, v / a)--    negateVector (x,y,z,u,v) = (-x, -y, -z, -u, -v)--    (x1,y1,z1,u1,v1) ^+^ (x2,y2,z2,u2,v2) = (x1+x2, y1+y2, z1+z2, u1+u2, v1+v2)--    (x1,y1,z1,u1,v1) ^-^ (x2,y2,z2,u2,v2) = (x1-x2, y1-y2, z1-z2, u1-u2, v1-v2)--    (x1,y1,z1,u1,v1) `dot` (x2,y2,z2,u2,v2) =-        x1 * x2 + y1 * y2 + z1 * z2 + u1 * u2 + v1 * v2

@@ -16,6 +16,7 @@  module AFRPTestsTask (task_tr, task_trs) where +import Control.Monad (when, forever) import FRP.Yampa import FRP.Yampa.Task @@ -83,10 +84,10 @@ 		 )     where         sawtooth =-	    forEver ((mkTask (constant 2.0 >>> integral &&& never))+	    forever ((mkTask (constant 2.0 >>> integral &&& never)) 	             `timeOut` 1.5) -task_t3r :: [Either Double ()]	    +task_t3r :: [Either Double ()] task_t3r =     [Left 0.0,     Left 0.5,     Left 1.0,     Left 1.5,	-- 0.0 s      Left 2.0,     Left 2.5,     Left 0.0,     Left 0.5,	-- 1.0 s@@ -216,3 +217,16 @@     ]  task_tr = and task_trs++-- | Repeat m until result satisfies the predicate p+repeatUntil :: Monad m => m a -> (a -> Bool) -> m a+m `repeatUntil` p = m >>= \x -> if not (p x) then repeatUntil m p else return x++-- | C-style for-loop.+--+-- Example:+--+-- >>> for 0 (+1) (>=10) ...+for :: Monad m => a -> (a -> a) -> (a -> Bool) -> m b -> m ()+for i f p m = when (p i) $ m >> for (f i) f p m+

@@ -20,7 +20,6 @@ import FRP.Yampa.Conditional import FRP.Yampa.EventS import FRP.Yampa.Hybrid-import FRP.Yampa.Utilities import FRP.Yampa.Switches  import AFRPTestsCommon

@@ -80,8 +80,7 @@                      && not (any (`isSuffixOf` fp) excludedFiles)      excludedFiles = [ "Vector2.hs", "Vector3.hs"-                    , "Point2.hs", "Point3.hs"-                    , "MergeableRecord.hs" ]+                    , "Point2.hs", "Point3.hs" ]  getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath]) getFilesAndDirectories dir = do