packages feed

reactive 0.9.3 → 0.9.4

raw patch · 13 files changed

+210/−47 lines, 13 filesdep +category-extras

Dependencies added: category-extras

Files

Makefile view
@@ -1,9 +1,1 @@-# For special configuration, especially for docs.  Otherwise see README.--server = code.haskell.org-server-dir = /srv/code-server-url-dir =--# extra-configure-args += --enable-library-profiling --enable-executable-profiling--include ../my-cabal-make.inc+include ../cho-cabal-make.inc
reactive.cabal view
@@ -1,5 +1,5 @@ Name:                reactive-Version:             0.9.3+Version:             0.9.4 Synopsis:            Simple foundation for functional reactive programming Category:            reactivity, FRP Description:@@ -33,7 +33,8 @@ Library     Build-Depends:       base, old-time, random, QuickCheck < 2.0,                          TypeCompose>=0.6.0, vector-space>=0.5,-                         unamb>=0.1.2, checkers >= 0.1.2+                         unamb>=0.1.2, checkers >= 0.1.2,+                         category-extras >= 0.53.5     -- This library uses the ImpredicativeTypes flag, and it depends     -- on vector-space, which needs ghc >= 6.9     if impl(ghc < 6.9) {
src/FRP/Reactive.hs view
@@ -31,7 +31,7 @@     -- ** Useful with events.   , joinMaybes, filterMP     -- * Behaviors-  , BehaviorG, Behavior+  , BehaviorG, Behavior, Behaviour   , time   , stepper, switcher --, select   , snapshotWith, snapshot, snapshot_, whenE
src/FRP/Reactive/Behavior.hs view
@@ -1,6 +1,7 @@-{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, TypeFamilies #-}-{-# LANGUAGE TypeSynonymInstances, CPP #-}-{-# OPTIONS_GHC -Wall #-}+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, TypeFamilies+           , TypeOperators+  #-}+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-} ---------------------------------------------------------------------- -- | -- Module      :  FRP.Reactive.Behavior@@ -15,7 +16,7 @@  module FRP.Reactive.Behavior   (-    BehaviorG, Behavior+    BehaviorG, Behavior, Behaviour   , time   , stepper, switcher --, select   , snapshotWith, snapshot, snapshot_, whenE@@ -27,6 +28,10 @@ import Control.Applicative (Applicative,(<$>),pure) -- import Control.Monad (join) +import Control.Comonad++import Control.Compose ((:.)(..))+ import Data.VectorSpace  import qualified FRP.Reactive.Reactive as R@@ -40,6 +45,9 @@ -- the interface generality worth the complexity? type Behavior = BehaviorG ITime TimeT +-- Synonym for 'Behavior'+type Behaviour = Behavior+ -- | The identity generalized behavior.  Has value @t@ at time @t@. time :: Behavior TimeT time = beh (pure (fun id))@@ -152,7 +160,7 @@ monoidB = scanlB mappend mempty  -- | Like 'sum' for behaviors.-sumB :: VectorSpace v => Event v -> Behavior v+sumB :: AdditiveGroup a => Event a -> Behavior a sumB = result rToB R.sumR  -- | Start out blank ('Nothing'), latching onto each new @a@, and blanking@@ -183,8 +191,32 @@ -- Investigate.  +---- Comonadic stuff++-- Orphan.  Move elsewhere++instance (Functor g, Functor f, Copointed g, Copointed f)+      => Copointed (g :. f) where+  extract = extract . fmap extract . unO++-- WORKING HERE++-- The plan for duplicate:+--+--   (g :. f) a -> g (f a) -> g (f (f a)) -> g (g (f (f a)))+--              -> g (f (g (f a))) -> (g :. f) (g (f a))+--              -> (g :. f) ((g :. f) a) -> ++-- But we'll have to do that middle twiddle, which I couldn't do for+-- behaviors to get a Monad either.  Is there another way?+++-- instance Comonad (g :. f) where+--   duplicate +++ -- Standard instances for applicative functors  -- #define APPLICATIVE Behavior -- #include "Num-inc.hs"-
src/FRP/Reactive/Fun.hs view
@@ -25,14 +25,15 @@ #if __GLASGOW_HASKELL__ < 610                      hiding (pure) #endif+import Text.Show.Functions () +import Control.Comonad+ import Test.QuickCheck import Test.QuickCheck.Checkers import Test.QuickCheck.Classes import Test.QuickCheck.Applicative () -import Text.Show.Functions ()- import FRP.Reactive.Internal.Fun  @@ -103,6 +104,17 @@   second          = Fun . second . apply   K a'  *** K b'  = K (a',b')   f     *** g     = first f >>> second g++instance Monoid t => Copointed (Fun t) where+  extract = extract . apply++instance Monoid t => Comonad (Fun t) where+  duplicate (K   a) = K   (K a)+  duplicate (Fun f) = Fun (Fun . duplicate f)++++----------------------------------  batch :: TestBatch batch = ( "FRP.Reactive.Fun"
src/FRP/Reactive/Future.hs view
@@ -95,6 +95,11 @@ withTimeF :: FutureG t a -> FutureG t (Time t, a) withTimeF = inFuture $ \ (t,a) -> (t,(t,a)) +-- TODO: Eliminate this Monoid instance.  Derive Monoid along with all the+-- other classes.  And don't use mempty and mappend for the operations+-- below.  For one thing, the current instance makes Future a monoid but+-- unFuture not be a monoid morphism.+ instance Ord t => Monoid (FutureG t a) where   mempty = Future (maxBound, error "Future mempty: it'll never happen, buddy")   -- Pick the earlier future.@@ -127,6 +132,7 @@ --  -- This function is an abstraction leak.  Don't export it to library -- users.+   {----------------------------------------------------------
src/FRP/Reactive/Improving.hs view
@@ -17,7 +17,7 @@   ) where  --- import Data.Function (on)+import Data.Function (on)  import Data.Unamb (unamb,asAgree,parCommute) import Test.QuickCheck.Checkers@@ -48,10 +48,13 @@    uMinV = if uLeqV then u else v    -- u <= v: Try @v `compare` u /= LT@ and @u `compare` v /= GT@.    uLeqV = (vComp u /= LT) `unamb` (uComp v /= GT)-   minComp = if uLeqV then uComp else vComp    -- (u `min` v) `compare` t: Try comparing according to whether u <= v,    -- or go with either answer if they agree, e.g., if both say GT.-   wComp t = minComp t `unamb` (uComp t `asAgree` vComp t)+   wComp t = minComp `unamb` (uCt `asAgree` vCt)+             where+               minComp = if uLeqV then uCt else vCt+               uCt = uComp t+               vCt = vComp t  -- | Efficient combination of 'max' and '(>=)' maxI :: Ord a => Improving a -> Improving a -> (Improving a,Bool)@@ -62,21 +65,18 @@    uGeqV = (vComp u /= GT) `unamb` (uComp v /= LT)    -- (u `max` v) `compare` t: Try comparing according to whether u >= v,    -- or go with either answer if they agree, e.g., if both say LT.-   maxComp = if uGeqV then uComp else vComp-   wComp t = maxComp t `unamb` (uComp t `asAgree` vComp t)+   wComp t = maxComp `unamb` (uCt `asAgree` vCt)+             where+               maxComp = if uGeqV then uCt else vCt+               uCt = uComp t+               vCt = vComp t  -- TODO: factor commonality out of 'minI' and 'maxI' or combine into -- a single function. --- -- | Interpret 'Nothing' values as lower bounds--- improveMbs :: [(t, Maybe a)] -> [(Improving t, a)]--- ...---- No.  Don't implement & export improveMbs.  If it's being used, then--- we're not benefitting from this fancy multi-threaded implementation of--- Improving.- -- TODO: Are the lazy patterns at all helpful? -instance (EqProp a) => EqProp (Improving a) where-  (Imp a _) =-= (Imp b _) = a =-= b+instance EqProp a => EqProp (Improving a) where+  (=-=) = (=-=) `on` exact++-- TODO: revisit (=-=).  Maybe it doesn't have to test for full equality.
src/FRP/Reactive/Internal/Behavior.hs view
@@ -15,12 +15,14 @@  module FRP.Reactive.Internal.Behavior (BehaviorG(..), beh, unb) where +import Prelude hiding (zip,unzip)  import Data.Monoid (Monoid(..)) import Control.Applicative (Applicative(pure),liftA2)  -- TypeCompose import Control.Compose ((:.)(..))+import Data.Zip (Zip(..),Unzip(..))  import qualified FRP.Reactive.Reactive as R -- import FRP.Reactive.Reactive (TimeT)@@ -62,6 +64,12 @@ instance (Applicative (R.ReactiveG tr :. Fun tf), Monoid a)       => Monoid ((R.ReactiveG tr :. Fun tf) a) where   { mempty = pure mempty; mappend = liftA2 mappend }++-- Standard 'Zip' for an 'Applicative'+instance Ord tr => Zip (BehaviorG tr tf) where zip = liftA2 (,)++-- Standard 'Unzip' for a 'Functor'+instance Unzip (BehaviorG tr tf) where {fsts = fmap fst; snds = fmap snd}  -- | Wrap a reactive time fun as a behavior. beh :: R.ReactiveG tr (Fun tf a) -> BehaviorG tr tf a
src/FRP/Reactive/Internal/Future.hs view
@@ -23,6 +23,8 @@  import Control.Applicative (Applicative(..)) +import Control.Comonad (Copointed,Comonad)+ import Test.QuickCheck  import FRP.Reactive.Internal.Misc (Sink)@@ -42,9 +44,7 @@ -- time\/value pair.  Particularly useful with time types that have -- non-flat structure. newtype FutureG t a = Future { unFuture :: (Time t, a) }-  deriving (Functor, Applicative, Monad, Show,  Arbitrary)---- TODO: see if the following definition is really necessary, instead of deriving.+  deriving (Functor, Applicative, Monad, Copointed, Comonad, Show,  Arbitrary)  --  The 'Applicative' and 'Monad' instances rely on the 'Monoid' instance -- of 'Max'.
src/FRP/Reactive/Num.hs view
@@ -1,11 +1,26 @@ {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}+----------------------------------------------------------------------+-- |+-- Module      :  FRP.Reactive.Num+-- Copyright   :  (c) Conal Elliott 2008+-- License     :  BSD3+-- +-- Maintainer  :  conal@conal.net+-- Stability   :  experimental+-- +-- Numeric class instances for behaviors+----------------------------------------------------------------------  module FRP.Reactive.Num () where +import Prelude hiding (zip,unzip)+ import FRP.Reactive.Behavior import Control.Applicative +import Data.Zip+ noOv :: String -> String -> a noOv ty meth = error $ meth ++ ": No overloading for " ++ ty @@ -21,6 +36,16 @@   min = liftA2 min   max = liftA2 max +instance Enum a => Enum (Behavior a) where+  succ           = fmap succ+  pred           = fmap pred+  toEnum         = pure . toEnum+  fromEnum       = noFun "fromEnum"+  enumFrom       = noFun "enumFrom"+  enumFromThen   = noFun "enumFromThen"+  enumFromTo     = noFun "enumFromTo"+  enumFromThenTo = noFun "enumFromThenTo"+ instance Show (Behavior b) where   show      = noFun "show"   showsPrec = noFun "showsPrec"@@ -34,6 +59,18 @@   abs         = fmap abs   signum      = fmap signum +instance (Num a, Ord a) => Real (Behavior a) where+  toRational = noFun "toRational"++instance Integral a => Integral (Behavior a) where+  quot      = liftA2 quot+  rem       = liftA2 rem+  div       = liftA2 div+  mod       = liftA2 mod+  quotRem   = (fmap.fmap) unzip (liftA2 quotRem)+  divMod    = (fmap.fmap) unzip (liftA2 divMod)+  toInteger = noFun "toInteger"+ instance Fractional b => Fractional (Behavior b) where   recip        = fmap recip   fromRational = pure . fromRational@@ -54,3 +91,25 @@   atanh = fmap atanh   acosh = fmap acosh +instance RealFrac a => RealFrac (Behavior a) where+  properFraction = noFun "properFraction"+  truncate       = noFun "truncate"+  round          = noFun "round"+  ceiling        = noFun "ceiling"+  floor          = noFun "floor"++instance RealFloat a => RealFloat (Behavior a) where+  floatRadix     = noFun "floatRadix"+  floatDigits    = noFun "floatDigits"+  floatRange     = noFun "floatRange"+  decodeFloat    = noFun "decodeFloat"+  encodeFloat    = (fmap.fmap) pure encodeFloat+  exponent       = noFun "exponent"+  significand    = noFun "significand"+  scaleFloat n   = fmap (scaleFloat n)+  isNaN          = noFun "isNaN"+  isInfinite     = noFun "isInfinite"+  isDenormalized = noFun "isDenormalized"+  isNegativeZero = noFun "isNegativeZero"+  isIEEE         = noFun "isIEEE"+  atan2          = liftA2 atan2
src/FRP/Reactive/PrimReactive.hs view
@@ -67,6 +67,8 @@ import Data.Function (on) -- import Debug.Trace (trace) +import Control.Comonad+ -- TODO: eliminate the needs for this stuff. import Control.Concurrent (threadDelay) import Control.Exception (evaluate)@@ -397,6 +399,7 @@ -- rToE <$> er ::: EventG t (EventG t a) -- join (rToE <$> er) ::: EventG t a + -- | Access occurrence times in an event.  See also 'withTimeGR'. withTimeGE :: EventG t a -> EventG t (a, Time t) withTimeGE = inEvent $ inFuture $ \ (t,r) -> (t, withTimeGR t r)@@ -509,8 +512,6 @@ -- I'm not sure about @<@ vs @<=@ above.  -- -- | Sample a reactive value at a sequence of monotonically non-decreasing -- times.  Deprecated, because it does not reveal when value is known to -- be repeated in the output.  Those values won't be recomputed, but they@@ -551,6 +552,56 @@  -- Standard instance for functors instance Unzip (EventG t) where {fsts = fmap fst; snds = fmap snd}+++{--------------------------------------------------------------------+    Comonadic stuff+--------------------------------------------------------------------}++instance Monoid t => Copointed (EventG t) where+  -- E a -> F (R a) -> R a -> a+  extract = extract . extract . eFuture++-- Here's the plan for 'duplicate':+-- +--   E a -> F (R a) -> F (R (R a)) -> F (F (R (R a)))+--       -> F (R (F (R a))) -> E (F (R a)) -> E (E a)+++instance Monoid t => Comonad (EventG t) where+  duplicate =+    fmap Event . Event . fmap frTOrf . duplicate . fmap duplicate . eFuture++-- This frTOrf definition type-checks.  Is it what we want?+frTOrf :: FutureG t (ReactiveG t a) -> ReactiveG t (FutureG t a)+frTOrf ~(Future (ta,e)) = (Future . (,) ta) <$> e++-- TODO: Reconsider E = F :. R .  Didn't work with absolute time.  What+-- about relative time?+++instance Monoid t => Copointed (ReactiveG t) where+  -- extract = extract . rat+  -- Semantically: extract == extract . rat == (`rat` mempty) But mempty+  -- is the earliest time (since I'm using the Max monoid *), so here's a+  -- cheap alternative that also doesn't require Ord t:+  extract (a `Stepper` _) = a++-- extract r == extract (rat r) == rat r mempty++-- * Moreover, mempty is the earliest time in the Sum monoid on+-- non-negative values, for relative-time behaviors.++instance Monoid t => Comonad (ReactiveG t) where+  duplicate r@(_ `Stepper` Event u) =+    r `Stepper` Event (duplicate <$> u)++-- TODO: Prove the morphism law:+-- +--   fmap rat . rat . dup == dup . rat++-- Reactive is like the stream comonad+-- TODO: try again letting events and reactives be streams of futures.   {--------------------------------------------------------------------
src/FRP/Reactive/Reactive.hs view
@@ -31,7 +31,6 @@   , mealy, mealy_, countE, countE_, diffE     -- * Reactive values   , Reactive-  , Source   , snapshot_, snapshot, whenE   , scanlR, monoidR, eitherE, maybeR, flipFlop, countR   , splitE, switchE@@ -208,16 +207,16 @@ withNextEWith f e =  fmap (uncurry f) (withNextE e)  --- | State machine, given initial value and transition function.  Carries--- along event data.  See also 'mealy_'.+-- | Mealy-style state machine, given initial value and transition+-- function.  Carries along event data.  See also 'mealy_'. mealy :: Ord t => s -> (s -> s) -> EventG t b -> EventG t (b,s) mealy s0 f = scanlE h (b0,s0)  where    b0        = error "mealy: no initial value"    h (_,s) b = (b, f s) --- | State machine, given initial value and transition function.--- Forgetful version of 'mealy'.+-- | Mealy-style state machine, given initial value and transition+-- function.  Forgetful version of 'mealy'. mealy_ :: Ord t => s -> (s -> s) -> EventG t b -> EventG t s mealy_ = (result.result.result.fmap) snd mealy @@ -256,8 +255,8 @@ -- | Reactive values, specialized to improving doubles for time type Reactive = ReactiveG ITime --- | Compatibility synonym (for ease of transition from DataDriven)-type Source = Reactive+-- -- | Compatibility synonym (for ease of transition from DataDriven)+-- type Source = Reactive   -- | Snapshot a reactive value whenever an event occurs.
+ src/Test.hs view
@@ -0,0 +1,3 @@+-- Run tests.  ghc --make Test.hs -o test ; ./test++import Test.Reactive