frpnow 0.11 → 0.12

raw patch · 5 files changed

+183/−14 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog +1/−0
• Control/FRPNow/Core.hs +14/−10
• Control/FRPNow/Lib.hs +10/−0
• Control/FRPNow/Time.hs +157/−3
• frpnow.cabal +1/−1

@@ -1,2 +1,3 @@+0.12 Fixed BehaviorFix, added integration 0.11 Fixed import applicative 0.1 Initial version

@@ -162,7 +162,10 @@           Occ b' -> runB b'           E em'  -> return (x, E em') switch' (B bm) (E em) = B $-    em >>= \r -> case r of+    -- liftIO (traceIO "switching!") >>+    em >>= \r ->+     -- liftIO (traceIO "ran ev") >>+     case r of         Never      -> bm         Occ   b'   -> runB b'         E em'      -> @@ -204,8 +207,8 @@ whenJust' (Const Nothing)  = pure never whenJust' (Const (Just x)) = pure (pure x) whenJust' (B m) = B $ -    do  (h, t) <- m-        case h of+    do (h, t) <- m+       case h of          Just x -> return (return x, whenJust'  <$> t)          Nothing ->            do  en <- planM (runB . whenJust'  <$> t)@@ -220,7 +223,7 @@      case h of       Just x -> do v <- fst <$> runB x; return (pure v, whenJustSample' <$> t)       Nothing -> do en <- planM (runB . whenJustSample' <$> t)-                    return (en >>= fst, en >>= snd)+                    return (en >>= fst, never)  instance Monad Behavior where   return x = B $ return (x, never)@@ -228,8 +231,8 @@  instance MonadFix Behavior where   mfix f = B $ mfix $ \(~(h,_)) ->-       do  ~(h',t) <- runB (f h)-           return (h, mfix f <$ t)+       do  (h',t) <- runB (f h)+           return (h', mfix f <$ t )  -- | Introduce a change over time. --@@ -262,7 +265,7 @@ -- If @b@ never again is positive then the result is 'never'.  whenJust :: Behavior (Maybe a) -> Behavior (Event a)-whenJust b = memoB (whenJust' b)+whenJust b = (whenJust' b)   -- | A more optimized version of:@@ -284,7 +287,7 @@ -- the behavior is sampled, an error is thrown. futuristic :: Behavior (Event a) -> Behavior (Event a) futuristic b =  B $ do e <- makeLazy (joinEm <$> runB b) -                       return (fst <$> e, snd <$> e)+                       return (fst <$> e,snd <$> e)   where joinEm (e,es) = (,) <$> e <*> es  unrunB :: (a,Event (Behavior a)) -> Behavior a @@ -503,11 +506,12 @@ tryPlans = ReaderT $ tryEm where   tryEm env =      do pl <- readIORef (plansRef env)-       --putStrLn ("nr plans: " ++ show (length pl))+      -- putStrLn ("nr plans: " ++ show (length pl))        writeIORef (plansRef env) []        runReaderT (mapM_ tryPlan (reverse pl)) env   tryPlan (SomePlan pr) = -   do  ps <-  liftIO (deRef pr) +   do  -- liftIO (traceIO "plan!")+       ps <-  liftIO (deRef pr)         case ps of         Just p -> do  eres <- runE (planToEv p)                       case eres of

@@ -23,6 +23,7 @@    cmpTime,    EvOrd(..),    -- * Fold and state+   prev,    foldB,    sampleUntil,    -- * Sample behaviors on events@@ -59,6 +60,15 @@   boolToMaybe True   = Just ()   boolToMaybe False  = Nothing ++prev :: Eq a => a -> Behavior a -> Behavior (Behavior a)+prev i b = loop i where+  loop i = do e <- nxtCur+              return (i `step` e)+  nxtCur = futuristic $ +             do cur <- b+                e <- change b+                planB (loop cur <$ e)  -- | Gives at any point in time the event that the input behavior changes, and the new value of the input behavior. change :: Eq a => Behavior a -> Behavior (Event a)

@@ -1,4 +1,4 @@-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TupleSections,TypeOperators,MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}  ----------------------------------------------------------------------------- -- |@@ -16,7 +16,7 @@ -- The clock itself is created by a function specialized to the -- GUI library you are using FRP with such as 'Control.FRPNow.GTK.getClock' -module Control.FRPNow.Time(localTime,timeFrac, lastInputs, bufferBehavior,delayBy, delayByN) where+module Control.FRPNow.Time(localTime,timeFrac, lastInputs, bufferBehavior,delayBy, delayByN, delay, integrate, VectorSpace(..)) where  import Control.FRPNow.Core import Control.FRPNow.Lib@@ -121,6 +121,160 @@                    ((t1,v1) : (t2,v2) : rest)                     | sampleTime >= t2 -> loop n ((t2,v2) : rest)                     | otherwise -> v1 : loop (n-1) l-   +++-- | Integration using rectangle rule approximation. Integration depends on when we start integrating so the result is @Behavior (Behavior v)@.+integrate :: (Show v, Show time, VectorSpace v time) => +             Behavior time -> Behavior v -> Behavior (Behavior v)+integrate time v = do t <- time +                      vp <- delay time (t,zeroVector) ((,) <$> time <*> v)+                      foldB add zeroVector $ (,) <$> vp <*> time+   where add total ((t1,v),t2) = total ^+^ (((t2 - t1) * 0.5) *^ v)+++-- | Delay a behavior by one tick of the clock. Occasionally useful to prevent immediate feedback loops.+delay ::  Eq time  =>  Behavior time -> a -> Behavior a -> Behavior (Behavior a)+delay time i b = loop i where+  loop i =+           do e <- futuristic $ +                        do (t,cur) <- (,) <$> time <*> b+                           e <- when ((/= t) <$> time)+                           return (cur <$ e)+              e' <- plan ( loop <$> e)+              return (i `step` e')++infixr *^+infixl ^/+infix 7 `dot`+infixl 6 ^+^, ^-^++-- | A type class for vector spaces. Stolen from Yampa. Thanks Henrik :)++-- Minimal instance: zeroVector, (*^), (^+^), dot+class (Eq a, Eq v, Ord v, Ord a, Floating a) => VectorSpace v a | v -> a where+    zeroVector   :: v+    (*^)         :: a -> v -> v+    (^/)         :: v -> a -> v+    negateVector :: v -> v+    (^+^)        :: v -> v -> v+    (^-^)        :: v -> v -> v+    dot          :: v -> v -> a+    norm         :: v -> a+    normalize    :: v -> v++    v ^/ a = (1/a) *^ v++    negateVector v = (-1) *^ v++    v1 ^-^ v2 = v1 ^+^ negateVector v2++    norm v = sqrt (v `dot` v)++    normalize v = if nv /= 0 then v ^/ nv else error "normalize: zero vector"+        where nv = norm v++------------------------------------------------------------------------------+-- Vector space instances for Float and Double+------------------------------------------------------------------------------++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+++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 instances for small tuples of Floating+------------------------------------------------------------------------------++instance (Eq a, Floating a, Ord 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+++instance (Eq a, Floating a, Ord 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+++instance (Eq a, Floating a, Ord 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+++instance (Eq a, Floating a, Ord 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 

@@ -1,5 +1,5 @@ Name:                frpnow-Version:             0.11+Version:             0.12 Synopsis:	     Principled practical FRP Description:         FRP with first-class behaviors and interalized IO, without space leaks License:             BSD3