Minimal library, with several lift implementations (to be simplified)

.gitignore

@@ -0,0 +1,18 @@
+dist
+dist-*
+cabal-dev
+*.o
+*.hi
+*.chi
+*.chs.h
+*.dyn_o
+*.dyn_hi
+.hpc
+.hsenv
+.cabal-sandbox/
+cabal.sandbox.config
+*.prof
+*.aux
+*.hp
+*.eventlog
+.stack-work/

LICENSE

@@ -0,0 +1,14 @@
+Copyright (c) 2015-2016, Ivan Perez and Manuel Bärenz.
+All rights reserved. DO NOT REDISTRIBUTE.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND THE CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDERS OR THE CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS
+OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
+TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
+USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

bearriver.cabal

@@ -0,0 +1,43 @@
+name:                bearriver
+version:             0.1.0.0
+synopsis:            Generalised reactive framework supporting classic, arrowized and monadic FRP.
+-- description:
+license:             AllRightsReserved
+license-file:        LICENSE
+author:              Ivan Perez, Manuel Bärenz
+maintainer:          ivan.perez@keera.co.uk
+-- copyright:
+category:            Reactivity, FRP
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+library
+  exposed-modules:   Control.Monad.Trans.MStreamF
+                     Data.MonadicStreamFunction
+                     Data.MonadicStreamFunction.Core
+                     Data.MonadicStreamFunction.ArrowChoice
+                     Data.MonadicStreamFunction.ArrowLoop
+                     Data.MonadicStreamFunction.ArrowPlus
+                     Data.MonadicStreamFunction.Instances
+                     Data.MonadicStreamFunction.Instances.Num
+                     Data.MonadicStreamFunction.Instances.VectorSpace
+                     Data.MonadicStreamFunction.Parallel
+
+		     -- Auxiliary definitions
+                     Control.Monad.SamplingMonad
+                     Control.Monad.TaggingMonad
+                     Data.VectorSpace
+                     Data.VectorSpace.Instances
+                     Data.VectorSpace.Tuples
+                     Data.VectorSpace.Specific
+
+  other-modules:     Control.Arrow.Util
+                     Data.Tuple.Util
+
+  build-depends:     base >=4.6 && < 5,
+                     transformers,
+                     transformers-base
+  hs-source-dirs:    src
+  default-language:  Haskell2010
+  ghc-options:       -Wall -fno-warn-unused-do-bind

src/Control/Arrow/Util.hs

@@ -0,0 +1,30 @@
+module Control.Arrow.Util where
+
+-- Do we even need that module? How much of it exists in the standard library?
+
+import Control.Arrow
+import Control.Category (id)
+import Prelude hiding (id)
+
+-- Hah! I shall implement this for TimelessSFs and SFs at the same time!
+constantly :: Arrow a => b -> a c b
+constantly = arr . const
+{-# INLINE constantly #-}
+
+-- More strongly bound arrow combinators
+infixr 4 <-<
+(<-<) :: Arrow a => a c d -> a b c -> a b d
+(<-<) = (<<<)
+{-# INLINE (<-<) #-}
+
+infixr 4 >->
+(>->) :: Arrow a => a b c -> a c d -> a b d
+(>->) = (>>>)
+{-# INLINE (>->) #-}
+
+
+(&&&!) :: Arrow a => a b c -> a b () -> a b c
+a1 &&&! a2 = (a1 &&& a2) >>> arr fst
+
+sink :: Arrow a => a b c -> a c () -> a b c
+a1 `sink` a2 = a1 >>> (id &&& a2) >>> arr fst

src/Control/Monad/SamplingMonad.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE ExistentialQuantification #-}
+module Control.Monad.SamplingMonad where
+
+import Control.Monad.TaggingMonad
+import Data.Monoid
+import Data.Maybe.Util
+
+type SamplingMonad t a = TaggingMonad (NextSample t) a
+
+data NextSample a = Ord a => NextSample { unNext :: Maybe a }
+
+instance Ord a => Monoid (NextSample a) where
+ mempty = NextSample Nothing
+ mappend (NextSample x) (NextSample y) = NextSample $ mergeMaybe min x y

src/Control/Monad/TaggingMonad.hs

@@ -0,0 +1,24 @@
+module Control.Monad.TaggingMonad where
+
+import Control.Applicative
+import Data.Monoid
+
+data TaggingMonad t a = TaggingMonad
+  { tag   :: t
+  , value :: a
+  }
+
+instance Functor (TaggingMonad t) where
+  fmap f (TaggingMonad t v) = TaggingMonad t (f v)
+
+instance Monoid t => Applicative (TaggingMonad t) where
+  pure f = TaggingMonad mempty f
+  (TaggingMonad t f) <*> (TaggingMonad t' x) =
+    (TaggingMonad (mappend t t') (f x))
+
+instance Monoid t => Monad (TaggingMonad t) where
+  return x = TaggingMonad mempty x
+  (TaggingMonad t x) >>= f = 
+    let TaggingMonad t' x' = f x
+    in TaggingMonad (mappend t t') x'
+