Merge branch 'develop'

# Conflicts:
#	default.nix

Author: Ryan Trinkle

.ghci

@@ -1,4 +1,4 @@
 :set -isrc
 :set -hide-package MonadCatchIO-mtl
 :set -hide-package monads-fd
-:set -XOverloadedStrings
+:seti -XOverloadedStrings

.travis.yml

@@ -0,0 +1,24 @@
+sudo: false
+before_install:
+  - travis_retry cabal-$CABALVER update
+  - export PATH=/opt/ghc/$GHCVER/bin:/opt/happy/1.19.5/bin:/opt/alex/3.1.4/bin:$PATH
+install:
+  - travis_retry cabal-$CABALVER install --only-dependencies -j --enable-tests
+script:
+  - cabal-$CABALVER configure -v2 --enable-tests
+  - cabal-$CABALVER build
+  - cabal-$CABALVER test
+  - cabal-$CABALVER sdist   # tests that a source-distribution can be generated
+# Check that the resulting source distribution can be built & installed.
+# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
+# `cabal install --force-reinstalls dist/*-*.tar.gz`
+  - SRC_TGZ=$(cabal-$CABALVER info . | awk '{print $2;exit}').tar.gz &&
+    (cd dist && cabal-$CABALVER install --force-reinstalls "$SRC_TGZ")
+
+matrix:
+  include:
+    - env: CABALVER=1.18 GHCVER=7.8.4
+      addons: {apt: {packages: [cabal-install-1.18, ghc-7.8.4, alex-3.1.4, happy-1.19.5], sources: [hvr-ghc]}}
+    - env: CABALVER=1.22 GHCVER=7.10.1
+      addons: {apt: {packages: [cabal-install-1.22, ghc-7.10.1, alex-3.1.4, happy-1.19.5],sources: [hvr-ghc]}}
+  fast_finish: true

default.nix

@@ -1,12 +1,15 @@
 { mkDerivation, dependent-map, dependent-sum
-, mtl, ref-tf, semigroups, these
+, mtl, ref-tf, semigroups, these, MemoTrie, exception-transformers
 }:
 mkDerivation {
   pname = "reflex";
-  version = "0.2";
+  version = "0.3";
   src = builtins.filterSource (path: type: baseNameOf path != ".git") ./.;
   buildDepends = [
-    dependent-map dependent-sum mtl ref-tf semigroups these
+    dependent-map dependent-sum mtl ref-tf semigroups these exception-transformers
+  ];
+  testDepends = [
+    MemoTrie
   ];
   license = null;
 }

reflex.cabal

@@ -1,5 +1,5 @@
 Name: reflex
-Version: 0.2
+Version: 0.3
 Synopsis: Higher-order Functional Reactive Programming
 Description: Reflex is a high-performance, deterministic, higher-order Functional Reactive Programming system
 License: BSD3
@@ -23,9 +23,12 @@ library
     mtl >= 2.1 && < 2.3,
     containers == 0.5.*,
     these == 0.4.*,
-    primitive == 0.5.*,
+    primitive >= 0.5 && < 0.7,
     template-haskell >= 2.9 && < 2.11,
-    ref-tf == 0.4.*
+    ref-tf == 0.4.*,
+    exception-transformers == 0.4.*,
+    transformers >= 0.2,
+    transformers-compat >= 0.3
 
   exposed-modules:
     Reflex,
@@ -38,9 +41,24 @@ library
     Data.Functor.Misc
 
   other-extensions: TemplateHaskell
-  ghc-prof-options: -fprof-auto
   ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2
 
+test-suite cross-impl
+  type: exitcode-stdio-1.0
+  main-is: Reflex/Test/CrossImpl.hs
+  other-modules:
+    Reflex.Pure
+  ghc-options: -O2 -main-is Reflex.Test.CrossImpl.test
+  hs-source-dirs: test
+  build-depends:
+    base,
+    reflex,
+    ref-tf,
+    mtl,
+    containers,
+    dependent-map,
+    MemoTrie == 0.6.*
+
 benchmark spider-bench
   type: exitcode-stdio-1.0
   hs-source-dirs: bench

src/Data/Functor/Misc.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE KindSignatures, GADTs, DeriveDataTypeable, RankNTypes, ScopedTypeVariables #-}
+{-# LANGUAGE KindSignatures, GADTs, DeriveDataTypeable, RankNTypes, ScopedTypeVariables, PolyKinds #-}
 module Data.Functor.Misc where
 
 import Data.GADT.Compare
@@ -8,8 +8,9 @@ import Data.Dependent.Map (DMap, DSum (..))
 import qualified Data.Dependent.Map as DMap
 import Data.Typeable hiding (Refl)
 import Data.These
+import Data.Maybe
 
-data WrapArg :: (* -> *) -> (* -> *) -> * -> * where
+data WrapArg :: (k -> *) -> (k -> *) -> * -> * where
   WrapArg :: f a -> WrapArg g f (g a)
 
 instance GEq f => GEq (WrapArg g f) where
@@ -61,6 +62,9 @@ rewrapDMap f = DMap.fromDistinctAscList . map (\(WrapArg k :=> v) -> WrapArg k :
 unwrapDMap :: (forall a. f a -> a) -> DMap (WrapArg f k) -> DMap k
 unwrapDMap f = DMap.fromDistinctAscList . map (\(WrapArg k :=> v) -> k :=> f v) . DMap.toAscList
 
+unwrapDMapMaybe :: (forall a. f a -> Maybe a) -> DMap (WrapArg f k) -> DMap k
+unwrapDMapMaybe f = DMap.fromDistinctAscList . catMaybes . map (\(WrapArg k :=> v) -> fmap (k :=>) $ f v) . DMap.toAscList
+
 mapToDMap :: Map k v -> DMap (Const2 k v)
 mapToDMap = DMap.fromDistinctAscList . map (\(k, v) -> Const2 k :=> v) . Map.toAscList
 

src/Reflex/Class.hs

@@ -1,11 +1,14 @@
 {-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, GADTs, ScopedTypeVariables, FunctionalDependencies, RecursiveDo, UndecidableInstances, GeneralizedNewtypeDeriving, StandaloneDeriving, EmptyDataDecls, NoMonomorphismRestriction, TypeOperators, DeriveDataTypeable, PackageImports, TemplateHaskell, LambdaCase #-}
 module Reflex.Class where
 
-import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)
-
+import Control.Applicative
 import Control.Monad.Identity hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
 import Control.Monad.State.Strict hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
 import Control.Monad.Reader hiding (mapM, mapM_, forM, forM_, sequence, sequence_)
+import Control.Monad.Trans.Writer (WriterT())
+import Control.Monad.Trans.Except (ExceptT())
+import Control.Monad.Trans.Cont (ContT())
+import Control.Monad.Trans.RWS (RWST())
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.These
 import Data.Align
@@ -17,10 +20,14 @@ import Data.Dependent.Map (DMap, DSum (..), GCompare (..), GOrdering (..))
 import qualified Data.Dependent.Map as DMap
 import Data.Functor.Misc
 import Data.Semigroup
+import Data.Traversable
+
+-- Note: must come last to silence warnings due to AMP on GHC < 7.10
+import Prelude hiding (mapM, mapM_, sequence, sequence_, foldl)
 
 import Debug.Trace (trace)
 
-class (MonadHold t (PushM t), MonadSample t (PullM t), Functor (Event t), Functor (Behavior t)) => Reflex t where
+class (MonadHold t (PushM t), MonadSample t (PullM t), MonadFix (PushM t), Functor (Event t), Functor (Behavior t)) => Reflex t where
   -- | A container for a value that can change over time.  Behaviors can be sampled at will, but it is not possible to be notified when they change
   data Behavior t :: * -> *
   -- | A stream of occurrences.  During any given frame, an Event is either occurring or not occurring; if it is occurring, it will contain a value of the given type (its "occurrence type")
@@ -39,14 +46,14 @@ class (MonadHold t (PushM t), MonadSample t (PullM t), Functor (Event t), Functo
   type PullM t :: * -> *
   -- | Merge a collection of events; the resulting Event will only occur if at least one input event is occuring, and will contain all of the input keys that are occurring simultaneously
   merge :: GCompare k => DMap (WrapArg (Event t) k) -> Event t (DMap k) --TODO: Generalize to get rid of DMap use --TODO: Provide a type-level guarantee that the result is not empty
-  -- | Efficiently fan-out an event to many destinations.  This function should be partially applied, and then the result applied repeatedly to create child events 
+  -- | Efficiently fan-out an event to many destinations.  This function should be partially applied, and then the result applied repeatedly to create child events
   fan :: GCompare k => Event t (DMap k) -> EventSelector t k --TODO: Can we help enforce the partial application discipline here?  The combinator is worthless without it
   -- | Create an Event that will occur whenever the currently-selected input Event occurs
   switch :: Behavior t (Event t a) -> Event t a
   -- | Create an Event that will occur whenever the input event is occurring and its occurrence value, another Event, is also occurring
   coincidence :: Event t (Event t a) -> Event t a
 
-class Monad m => MonadSample t m | m -> t where
+class (Applicative m, Monad m) => MonadSample t m | m -> t where
   -- | Get the current value in the Behavior
   sample :: Behavior t a -> m a
 
@@ -66,14 +73,44 @@ instance MonadSample t m => MonadSample t (ReaderT r m) where
 instance MonadHold t m => MonadHold t (ReaderT r m) where
   hold a0 = lift . hold a0
 
+instance (MonadSample t m, Monoid r) => MonadSample t (WriterT r m) where
+  sample = lift . sample
+
+instance (MonadHold t m, Monoid r) => MonadHold t (WriterT r m) where
+  hold a0 = lift . hold a0
+
+instance MonadSample t m => MonadSample t (StateT s m) where
+  sample = lift . sample
+
+instance MonadHold t m => MonadHold t (StateT s m) where
+  hold a0 = lift . hold a0
+
+instance MonadSample t m => MonadSample t (ExceptT e m) where
+  sample = lift . sample
+
+instance MonadHold t m => MonadHold t (ExceptT e m) where
+  hold a0 = lift . hold a0
+
+instance (MonadSample t m, Monoid w) => MonadSample t (RWST r w s m) where
+  sample = lift . sample
+
+instance (MonadHold t m, Monoid w) => MonadHold t (RWST r w s m) where
+  hold a0 = lift . hold a0
+
+instance MonadSample t m => MonadSample t (ContT r m) where
+  sample = lift . sample
+
+instance MonadHold t m => MonadHold t (ContT r m) where
+  hold a0 = lift . hold a0
+
 --------------------------------------------------------------------------------
 -- Convenience functions
 --------------------------------------------------------------------------------
 
 -- | Create an Event from another Event.
 -- The provided function can sample 'Behavior's and hold 'Event's.
 pushAlways :: Reflex t => (a -> PushM t b) -> Event t a -> Event t b
-pushAlways f e = push (liftM Just . f) e
+pushAlways f = push (liftM Just . f)
 
 -- | Flipped version of 'fmap'.
 ffor :: Functor f => f a -> (a -> b) -> f b
@@ -82,6 +119,28 @@ ffor = flip fmap
 instance Reflex t => Functor (Behavior t) where
   fmap f = pull . liftM f . sample
 
+instance Reflex t => Applicative (Behavior t) where
+  pure = constant
+  f <*> x = pull $ sample f `ap` sample x
+  _ *> b = b
+  a <* _ = a
+
+instance Reflex t => Monad (Behavior t) where
+  a >>= f = pull $ sample a >>= sample . f
+  -- Note: it is tempting to write (_ >> b = b); however, this would result in (fail x >> return y) succeeding (returning y), which violates the law that (a >> b = a >>= \_ -> b), since the implementation of (>>=) above actually will fail.  Since we can't examine Behaviors other than by using sample, I don't think it's possible to write (>>) to be more efficient than the (>>=) above.
+  return = constant
+  fail = error "Monad (Behavior t) does not support fail"
+
+instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
+  a <> b = pull $ liftM2 (<>) (sample a) (sample b)
+  sconcat = pull . liftM sconcat . mapM sample
+  times1p n = fmap $ times1p n
+
+instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
+  mempty = constant mempty
+  mappend a b = pull $ liftM2 mappend (sample a) (sample b)
+  mconcat = pull . liftM mconcat . mapM sample
+
 --TODO: See if there's a better class in the standard libraries already
 -- | A class for values that combines filtering and mapping using 'Maybe'.
 class FunctorMaybe f where
@@ -239,7 +298,7 @@ dmapToThese m = case (DMap.lookup LeftTag m, DMap.lookup RightTag m) of
 -- 'Event's occurs. If both occur at the same time they are combined
 -- using 'mappend'.
 appendEvents :: (Reflex t, Monoid a) => Event t a -> Event t a -> Event t a
-appendEvents e1 e2 = fmap (mergeThese mappend) $ align e1 e2
+appendEvents e1 e2 = mergeThese mappend <$> align e1 e2
 
 {-# DEPRECATED sequenceThese "Use bisequenceA or bisequence from the bifunctors package instead" #-}
 sequenceThese :: Monad m => These (m a) (m b) -> m (These a b)
@@ -299,3 +358,9 @@ instance Reflex t => Align (Event t) where
 -- occurs and the 'Behavior' is true at the time of occurence.
 gate :: Reflex t => Behavior t Bool -> Event t a -> Event t a
 gate = attachWithMaybe $ \allow a -> if allow then Just a else Nothing
+
+-- | Create a new behavior given a starting behavior and switch to a the
+--   behvior carried by the event when it fires.
+switcher :: (Reflex t, MonadHold t m)
+        => Behavior t a -> Event t (Behavior t a) -> m (Behavior t a)
+switcher b eb = pull . (sample <=< sample) <$> hold b eb

src/Reflex/Dynamic.hs

@@ -156,16 +156,22 @@ mapDynM f d = do
 -- time the 'Event' occurs using a folding function on the previous
 -- value and the value of the 'Event'.
 foldDyn :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
-foldDyn f = foldDynM (\o v -> return $ f o v)
+foldDyn f = foldDynMaybe $ \o v -> Just $ f o v
 
 -- | Create a 'Dynamic' using the initial value and change it each
 -- time the 'Event' occurs using a monadic folding function on the
 -- previous value and the value of the 'Event'.
 foldDynM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t b) -> b -> Event t a -> m (Dynamic t b)
-foldDynM f z e = do
+foldDynM f = foldDynMaybeM $ \o v -> liftM Just $ f o v
+
+foldDynMaybe :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> Maybe b) -> b -> Event t a -> m (Dynamic t b)
+foldDynMaybe f = foldDynMaybeM $ \o v -> return $ f o v
+
+foldDynMaybeM :: (Reflex t, MonadHold t m, MonadFix m) => (a -> b -> PushM t (Maybe b)) -> b -> Event t a -> m (Dynamic t b)
+foldDynMaybeM f z e = do
   rec let e' = flip push e $ \o -> do
             v <- sample b'
-            liftM Just $ f o v
+            f o v
       b' <- hold z e'
   return $ Dynamic b' e'
 
@@ -421,12 +427,20 @@ class RebuildSortedHList l where
   rebuildSortedHList :: [DSum (HListPtr l)] -> HList l
 
 instance RebuildSortedHList '[] where
-  rebuildSortedFHList [] = FHNil
-  rebuildSortedHList [] = HNil
+  rebuildSortedFHList l = case l of
+    [] -> FHNil
+    _ : _ -> error "rebuildSortedFHList{'[]}: empty list expected"
+  rebuildSortedHList l = case l of
+    [] -> HNil
+    _ : _ -> error "rebuildSortedHList{'[]}: empty list expected"
 
 instance RebuildSortedHList t => RebuildSortedHList (h ': t) where
-  rebuildSortedFHList ((WrapArg HHeadPtr :=> h) : t) = FHCons h $ rebuildSortedFHList $ map (\(WrapArg (HTailPtr p) :=> v) -> WrapArg p :=> v) t
-  rebuildSortedHList ((HHeadPtr :=> h) : t) = HCons h $ rebuildSortedHList $ map (\(HTailPtr p :=> v) -> p :=> v) t
+  rebuildSortedFHList l = case l of
+    ((WrapArg HHeadPtr :=> h) : t) -> FHCons h $ rebuildSortedFHList $ map (\(WrapArg (HTailPtr p) :=> v) -> WrapArg p :=> v) t
+    _ -> error "rebuildSortedFHList{h':t}: non-empty list with HHeadPtr expected"
+  rebuildSortedHList l = case l of
+    ((HHeadPtr :=> h) : t) -> HCons h $ rebuildSortedHList $ map (\(HTailPtr p :=> v) -> p :=> v) t
+    _ -> error "rebuildSortedHList{h':t}: non-empty list with HHeadPtr expected"
 
 dmapToHList :: forall l. RebuildSortedHList l => DMap (HListPtr l) -> HList l
 dmapToHList = rebuildSortedHList . DMap.toList
@@ -449,12 +463,16 @@ class AllAreFunctors (f :: a -> *) (l :: [a]) where
 
 instance AllAreFunctors f '[] where
   type FunctorList f '[] = '[]
-  toFHList HNil = FHNil
+  toFHList l = case l of
+    HNil -> FHNil
+    _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
   fromFHList FHNil = HNil
 
 instance AllAreFunctors f t => AllAreFunctors f (h ': t) where
   type FunctorList f (h ': t) = f h ': FunctorList f t
-  toFHList (a `HCons` b) = a `FHCons` toFHList b
+  toFHList l = case l of
+    a `HCons` b -> a `FHCons` toFHList b
+    _ -> error "toFHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
   fromFHList (a `FHCons` b) = a `HCons` fromFHList b
 
 collectDyn :: ( RebuildSortedHList (HListElems b)
@@ -475,14 +493,20 @@ class IsHList a where
 instance IsHList (a, b) where
   type HListElems (a, b) = [a, b]
   toHList (a, b) = hBuild a b
-  fromHList (a `HCons` b `HCons` HNil) = (a, b)
+  fromHList l = case l of
+    a `HCons` b `HCons` HNil -> (a, b)
+    _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
 
 instance IsHList (a, b, c, d) where
   type HListElems (a, b, c, d) = [a, b, c, d]
   toHList (a, b, c, d) = hBuild a b c d
-  fromHList (a `HCons` b `HCons` c `HCons` d `HCons` HNil) = (a, b, c, d)
+  fromHList l = case l of
+    a `HCons` b `HCons` c `HCons` d `HCons` HNil -> (a, b, c, d)
+    _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139
 
 instance IsHList (a, b, c, d, e, f) where
   type HListElems (a, b, c, d, e, f) = [a, b, c, d, e, f]
   toHList (a, b, c, d, e, f) = hBuild a b c d e f
-  fromHList (a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil) = (a, b, c, d, e, f)
+  fromHList l = case l of
+    a `HCons` b `HCons` c `HCons` d `HCons` e `HCons` f `HCons` HNil -> (a, b, c, d, e, f)
+    _ -> error "fromHList: impossible" -- Otherwise, GHC complains of a non-exhaustive pattern match; see https://ghc.haskell.org/trac/ghc/ticket/4139