Merge pull request reflex-frp#69 from lspitzner/develop

Add .gitignore for cabal; Add `unlessE`; Update Quickref.md a bit

.gitignore

@@ -1,4 +1,6 @@
 dist
+cabal.sandbox.config
+.cabal-sandbox/
 cabal-dev
 *.o
 *.hi

Quickref.md

@@ -48,17 +48,22 @@ Since MonadHold depends on MonadSample, any [S] function also runs in [H] contex
 [ ]   attachPromptlyDynWithMaybe :: (a -> b -> Maybe c) ->  Dynamic a -> Event b -> Event c
 
 -- Combine multiple Events
-[ ]   <>        :: Monoid a => Event a -> Event a -> Event a
-[ ]   mergeWith :: (a -> a -> a) -> [Event a] -> Event a
-[ ]   leftmost  :: [Event a] -> Event a
-[ ]   mergeList :: [Event a] -> Event (NonEmpty a)
-[ ]   merge     :: GCompare k => DMap (WrapArg Event k) -> Event (DMap k)
-[ ]   mergeMap  :: Ord k => Map k (Event a) -> Event (Map k a)
+[ ]   <>         ::      Semigroup a => Event a -> Event a -> Event a
+[ ]   difference ::                     Event a -> Event b -> Event a
+[ ]   align      ::                     Event a -> Event b -> Event (These a b)
+[ ]   alignWith  :: (These a b -> c) -> Event a -> Event b -> Event c
+[ ]   mergeWith  :: (a -> a -> a) -> [Event a] -> Event a
+[ ]   leftmost   :: [Event a] -> Event a
+[ ]   mergeList  :: [Event a] -> Event (NonEmpty a)
+[ ]   merge      :: GCompare k => DMap (WrapArg Event k) -> Event (DMap k)
+[ ]   mergeMap   :: Ord k => Map k (Event a) -> Event (Map k a)
 
 -- Efficient one-to-many fanout
-[ ]   fanMap ::      Ord k => Event (Map k a) -> EventSelector (Const2 k a)
-[ ]   fan    :: GCompare k => Event  (DMap k) -> EventSelector k
-[ ]   select ::                                  EventSelector k -> k a -> Event a
+[ ]   fanMap    ::      Ord k => Event (Map k a) -> EventSelector (Const2 k a)
+[ ]   fan       :: GCompare k => Event  (DMap k) -> EventSelector k
+[ ]   select    ::                                  EventSelector k -> k a -> Event a
+[ ]   fanEither ::            Event (Either a b) -> (Event a, Event b)
+[ ]   fanThese  ::            Event (These a b)  -> (Event a, Event b)
 
 -- Event to Event via function that can sample current values
 [ ]   push       :: (a -> m (Maybe b)) -> Event a -> Event b
@@ -124,7 +129,9 @@ Since MonadHold depends on MonadSample, any [S] function also runs in [H] contex
 -- Combine multiple Dynamics
 [ ]   mconcat                   :: Monoid a => [Dynamic a] -> Dynamic a
 [ ]   distributeDMapOverDynPure :: GCompare k => DMap (WrapArg Dynamic k) -> Dynamic (DMap k)
-[ ]   zipDynWith                :: (a -> b -> c) -> Dynamic a -> Dynamic b -> Dynamic c
+[ ]   <*>                       ::           Dynamic (a -> b) ->        Dynamic a -> Dynamic b
+[ ]   >>=                       ::                  Dynamic a -> (a -> Dynamic b) -> Dynamic b
+[ ]   zipDynWith                :: (a -> b -> c) -> Dynamic a -> Dynamic b        -> Dynamic c
 
 -- Efficient one-to-many fanout
 [ ]   demux   :: Ord k => Dynamic k -> Demux k

src/Reflex/Class.hs

@@ -34,6 +34,7 @@ module Reflex.Class
        , mergeMap
        , mergeList
        , mergeWith
+       , difference
          -- ** Breaking up 'Event's
        , splitE
        , fanEither
@@ -408,8 +409,21 @@ instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
 #endif
 
 --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
+-- Morally, @'FunctorMaybe' ~ KleisliFunctor 'Maybe'@. Also similar is the
+-- @Witherable@ typeclass, but it requires @Foldable f@ and @Traverable f@,
+-- and e.g. 'Event' is instance of neither.
+--
+-- A definition of 'fmapMaybe' must satisfy the following laws:
+--
+-- [/identity/]
+--   @'fmapMaybe' 'Just' ≡ 'id'@
+--
+-- [/composition/]
+--   @'fmapMaybe' (f <=< g) ≡ 'fmapMaybe' f . 'fmapMaybe' g@
+
+class Functor f => FunctorMaybe f where
   -- | Combined mapping and filtering function.
   fmapMaybe :: (a -> Maybe b) -> f a -> f b
 
@@ -640,7 +654,7 @@ switchPromptly ea0 eea = do
 
 instance Reflex t => Align (Event t) where
   nil = never
-  align ea eb = fmapMaybe dmapToThese $ merge $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
+  align = alignWithMaybe Just
 
 -- | Create a new 'Event' that only occurs if the supplied 'Event' occurs and
 -- the 'Behavior' is true at the time of occurence.
@@ -660,6 +674,7 @@ zipDyn = zipDynWith (,)
 
 -- | Combine two 'Dynamic's with a combining function.  The result will change
 -- whenever either (or both) input 'Dynamic' changes.
+-- More efficient than liftA2.
 zipDynWith :: Reflex t => (a -> b -> c) -> Dynamic t a -> Dynamic t b -> Dynamic t c
 zipDynWith f da db =
   let eab = align (updated da) (updated db)
@@ -703,6 +718,21 @@ distributeListOverDyn = distributeListOverDynWith id
 distributeListOverDynWith :: Reflex t => ([a] -> b) -> [Dynamic t a] -> Dynamic t b
 distributeListOverDynWith f = fmap (f . map (\(Const2 _ :=> Identity v) -> v) . DMap.toList) . distributeDMapOverDynPure . DMap.fromList . map (\(k, v) -> Const2 k :=> v) . zip [0 :: Int ..]
 
+-- | Create a new 'Event' that occurs when the first supplied 'Event' occurs
+-- unless the second supplied 'Event' occurs simultaneously.
+difference :: Reflex t => Event t a -> Event t b -> Event t a
+difference = alignWithMaybe $ \case
+  This a -> Just a
+  _      -> Nothing
+
+-- (intentially not exported, for now)
+alignWithMaybe
+  :: Reflex t => (These a b -> Maybe c) -> Event t a -> Event t b -> Event t c
+alignWithMaybe f ea eb =
+  fmapMaybe (f <=< dmapToThese)
+    $ merge
+    $ DMap.fromList [LeftTag :=> ea, RightTag :=> eb]
+
 
 --------------------------------------------------------------------------------
 -- Accumulator

src/Reflex/Spider/Internal.hs

@@ -840,10 +840,10 @@ instance Functor (Dynamic Identity) where
   fmap = newMapDyn
 
 instance Applicative (Dynamic Identity) where
-  pure = DynamicConst
+  pure  = DynamicConst
   (<*>) = zipDynWith ($)
-  _ *> b = b
-  a <* _ = a
+  (*>)  = zipDynWith (flip const)
+  (<*)  = zipDynWith const
 
 instance R.FunctorMaybe Event where
   fmapMaybe f = push $ return . f

test/Reflex/Test/Micro.hs

@@ -242,6 +242,11 @@ testCases =
       f <- fanMap . fmap toMap <$> events1
       return $ toList <$> mergeList [ select f (Const2 'b'), select f (Const2 'b'), select f (Const2 'e'), select f (Const2 'e') ]
 
+  , testE "difference" $ do
+      e1 <- events1
+      e2 <- events2
+      return $ e1 `difference ` e2
+
   ] where
 
     events1, events2, events3 ::  TestPlan t m => m (Event t String)