bearriver 0.13.1 → 0.13.1.1

raw patch · 9 files changed

+7/−540 lines, 9 filesdep +simple-affine-spacedep ~dunaiPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: simple-affine-space

Dependency ranges changed: dunai

API changes (from Hackage documentation)

Files

• bearriver.cabal +2/−8
• src/FRP/BearRiver.hs +5/−7
• src/FRP/Yampa.hs +0/−7
• src/FRP/Yampa/AffineSpace.hs +0/−43
• src/FRP/Yampa/Point2.hs +0/−55
• src/FRP/Yampa/Point3.hs +0/−60
• src/FRP/Yampa/Vector2.hs +0/−93
• src/FRP/Yampa/Vector3.hs +0/−111
• src/FRP/Yampa/VectorSpace.hs +0/−156

@@ -1,5 +1,5 @@ name:                bearriver-version:             0.13.1+version:             0.13.1.1 synopsis:            A replacement of Yampa based on Monadic Stream Functions. description:         A Yampa replacement built using Dunai. homepage:            keera.co.uk@@ -15,15 +15,9 @@  library   exposed-modules:     FRP.Yampa,-                       FRP.Yampa.Point2,-                       FRP.Yampa.VectorSpace,-                       FRP.Yampa.Vector2,-                       FRP.Yampa.Point3,-                       FRP.Yampa.Vector3,-                       FRP.Yampa.AffineSpace,                        FRP.BearRiver -  build-depends:       base >=4.6 && <5, transformers >=0.3, mtl, dunai >= 0.5.2 && < 0.6, MonadRandom+  build-depends:       base >=4.6 && <5, transformers >=0.3, mtl, dunai >= 0.6.0 && < 0.7, MonadRandom, simple-affine-space   hs-source-dirs:      src/   default-language:    Haskell2010 

@@ -36,7 +36,7 @@ import           Data.MonadicStreamFunction.Instances.ArrowLoop import           Data.MonadicStreamFunction.InternalCore import           Data.Traversable                               as T-import           FRP.Yampa.VectorSpace                          as X+import           Data.VectorSpace                               as X  infixr 0 -->, -:>, >--, >=- @@ -409,14 +409,14 @@ switch sf sfC = MSF $ \a -> do   (o, ct) <- unMSF sf a   case o of-    (_, Event c) -> unMSF (sfC c) a+    (_, Event c) -> local (const 0) (unMSF (sfC c) a)     (b, NoEvent) -> return (b, switch ct sfC)  dSwitch ::  Monad m => SF m a (b, Event c) -> (c -> SF m a b) -> SF m a b dSwitch sf sfC = MSF $ \a -> do   (o, ct) <- unMSF sf a   case o of-    (b, Event c) -> do (_,ct') <- unMSF (sfC c) a+    (b, Event c) -> do (_,ct') <- local (const 0) (unMSF (sfC c) a)                        return (b, ct')     (b, NoEvent) -> return (b, dSwitch ct sfC) @@ -540,8 +540,8 @@  where sfIO        = morphS (return.runIdentity) (runReaderS sf)         -- Sense-       senseSF     = switch senseFirst senseRest-       senseFirst  = constM senseI >>> (arr $ \x -> ((0, x), Event x))+       senseSF     = MSF.switch senseFirst senseRest+       senseFirst  = constM senseI >>> (arr $ \x -> ((0, x), Just x))        senseRest a = constM (sense True) >>> (arr id *** keepLast a)         keepLast :: Monad m => a -> MSF m (Maybe a) a@@ -551,8 +551,6 @@        -- actuateSF :: MSF IO b ()        -- actuateSF    = arr (\x -> (True, x)) >>> liftMSF (lift . uncurry actuate) >>> exitIf        actuateSF    = arr (\x -> (True, x)) >>> arrM (uncurry actuate)--       switch sf sfC = MSF.switch (sf >>> second (arr eventToMaybe)) sfC  -- * Debugging / Step by step simulation 

@@ -1,13 +1,6 @@ module FRP.Yampa (module X, SF, FutureSF) where  import           FRP.BearRiver         as X hiding (andThen, SF)-import           FRP.Yampa.AffineSpace as X-import           FRP.Yampa.Point2      as X-import           FRP.Yampa.Point3      as X-import           FRP.Yampa.Vector2     as X-import           FRP.Yampa.Vector3     as X-import           FRP.Yampa.VectorSpace as X- import           Data.Functor.Identity import qualified FRP.BearRiver         as BR 

@@ -1,43 +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----------------------------------------------------------------------------------- Affine Space type relation---------------------------------------------------------------------------------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.---- Minimal instance: origin, .+^, .^.-class (Floating a, VectorSpace v a) => AffineSpace p v a | p -> v, v -> a where-    origin   :: p-    (.+^)    :: p -> v -> p-    (.-^)    :: p -> v -> p-    (.-.)    :: p -> p -> v-    distance :: p -> p -> a--    p .-^ v = p .+^ (negateVector v)--    distance p1 p2 = norm (p1 .-. p2)

@@ -1,55 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--------------------------------------------------------------------------------------------- |--- 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).------ ToDo: Deriving Show, or provide dedicated show instance?-----------------------------------------------------------------------------------------------module FRP.Yampa.Point2 (-    -- module AFRPVectorSpace,-    -- module AFRPAffineSpace,-    -- module AFRPVector2,-    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----------------------------------------------------------------------------------- 2D point, constructors and selectors.---------------------------------------------------------------------------------data RealFloat a => Point2 a = Point2 !a !a deriving (Eq, Show)--point2X :: RealFloat a => Point2 a -> a-point2X (Point2 x _) = x--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)

@@ -1,60 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--------------------------------------------------------------------------------------------- |--- 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 (-    -- module AFRPVectorSpace,-    -- module AFRPAffineSpace,-    -- module AFRPVector3,-    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----------------------------------------------------------------------------------- 3D point, constructors and selectors.---------------------------------------------------------------------------------data RealFloat a => Point3 a = Point3 !a !a !a deriving Eq--point3X :: RealFloat a => Point3 a -> a-point3X (Point3 x _ _) = x--point3Y :: RealFloat a => Point3 a -> a-point3Y (Point3 _ y _) = y--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)

@@ -1,93 +0,0 @@-{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}--------------------------------------------------------------------------------------------- |--- 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).------ ToDo: Deriving Show, or provide dedicated show instance?--------------------------------------------------------------------------------------------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------------------------------------------------------------------------------------ 2D vector, constructors and selectors.----------------------------------------------------------------------------------- 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 RealFloat a => Vector2 a = Vector2 !a !a deriving (Eq,Show)--vector2 :: RealFloat a => a -> a -> Vector2 a-vector2 = Vector2--vector2X :: RealFloat a => Vector2 a -> a-vector2X (Vector2 x _) = x--vector2Y :: RealFloat a => Vector2 a -> a-vector2Y (Vector2 _ y) = y--vector2XY :: RealFloat a => Vector2 a -> (a, a)-vector2XY (Vector2 x y) = (x, y)--vector2Polar :: RealFloat a => a -> a -> Vector2 a-vector2Polar rho theta = Vector2 (rho * cos theta) (rho * sin theta)--vector2Rho :: RealFloat a => Vector2 a -> a-vector2Rho (Vector2 x y) = sqrt (x * x + y * y)--vector2Theta :: RealFloat a => Vector2 a -> a-vector2Theta (Vector2 x y) = atan2 y x--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---------------------------------------------------------------------------------vector2Rotate :: RealFloat a => a -> Vector2 a -> Vector2 a-vector2Rotate theta' v = vector2Polar (vector2Rho v) (vector2Theta v + theta')

@@ -1,111 +0,0 @@-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}--------------------------------------------------------------------------------------------- |--- 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).------ ToDo: Deriving Show, or provide dedicated show instance?--------------------------------------------------------------------------------------------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----------------------------------------------------------------------------------- 3D vector, constructors and selectors.----------------------------------------------------------------------------------- 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 RealFloat a => Vector3 a = Vector3 !a !a !a deriving (Eq, Show)--vector3 :: RealFloat a => a -> a -> a -> Vector3 a-vector3 = Vector3--vector3X :: RealFloat a => Vector3 a -> a-vector3X (Vector3 x _ _) = x--vector3Y :: RealFloat a => Vector3 a -> a-vector3Y (Vector3 _ y _) = y--vector3Z :: RealFloat a => Vector3 a -> a-vector3Z (Vector3 _ _ z) = z--vector3XYZ :: RealFloat a => Vector3 a -> (a, a, a)-vector3XYZ (Vector3 x y z) = (x, y, z)--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--vector3Rho :: RealFloat a => Vector3 a -> a-vector3Rho (Vector3 x y z) = sqrt (x * x + y * y + z * z)--vector3Theta :: RealFloat a => Vector3 a -> a-vector3Theta (Vector3 x y _) = atan2 y x--vector3Phi :: RealFloat a => Vector3 a -> a-vector3Phi v@(Vector3 _ _ z) = acos (z / vector3Rho v)--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---------------------------------------------------------------------------------vector3Rotate :: RealFloat a => a -> a -> Vector3 a -> Vector3 a-vector3Rotate theta' phi' v =-    vector3Spherical (vector3Rho v)-                     (vector3Theta v + theta')-                     (vector3Phi v + phi')

@@ -1,156 +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----------------------------------------------------------------------------------- Vector space type relation---------------------------------------------------------------------------------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.---- Minimal instance: zeroVector, (*^), (^+^), dot-class (Eq 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) => 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) => 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) => 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) => 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