@@ -1,3 +1,4 @@
1+
12{-# LANGUAGE CPP #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE FlexibleInstances #-}
@@ -12,6 +13,7 @@
1213{-# LANGUAGE TypeFamilies #-}
1314{-# LANGUAGE TypeOperators #-}
1415{-# LANGUAGE UndecidableInstances #-}
16+
1517module Reflex.Class where
1618
1719import Control.Applicative
@@ -28,16 +30,20 @@ import Data.Dependent.Map (DMap, DSum (..), GCompare (..), GOrdering (..))
2830import qualified Data.Dependent.Map as DMap
2931import Data.Dependent.Sum (ShowTag (..))
3032import Data.Foldable
33+import qualified Data.Functor.Bind as Bind
34+import Data.Functor.Bind hiding (join)
3135import Data.Functor.Compose
3236import Data.Functor.Constant
3337import Data.Functor.Misc
38+import Data.Functor.Plus
3439import Data.GADT.Compare ((:~:) (..), GEq (..))
3540import Data.GADT.Show (GShow (..))
3641import Data.List.NonEmpty (NonEmpty (..))
3742import Data.Map (Map)
3843import Data.Maybe
39−import Data.Monoid hiding ((<>))
44+import Data.Monoid hiding (Alt, (<>))
4045import Data.Semigroup (Semigroup, sconcat, stimes, stimesIdempotentMonoid, (<>))
46+import Data.String
4147import Data.These
4248import Data.Traversable
4349
@@ -224,21 +230,49 @@ pushAlways f = push (fmap Just . f)
224230ffor :: Functor f => f a -> (a -> b) -> f b
225231ffor = flip fmap
226232
227−instance Reflex t => Functor (Behavior t) where
228− fmap f = pull . fmap f . sample
229−
230233instance Reflex t => Applicative (Behavior t) where
231234 pure = constant
232235 f <*> x = pull $ sample f `ap` sample x
233236 _ *> b = b
234237 a <* _ = a
235238
239+instance Reflex t => Apply (Behavior t) where
240+ (<.>) = (<*>)
241+
242+instance Reflex t => Bind (Behavior t) where
243+ (>>-) = (>>=)
244+
245+instance (Reflex t, Fractional a) => Fractional (Behavior t a) where
246+ (/) = liftA2 (/)
247+ fromRational = pure . fromRational
248+ recip = fmap recip
249+
250+instance Reflex t => Functor (Behavior t) where
251+ fmap f = pull . fmap f . sample
252+
253+instance (Reflex t, IsString a) => IsString (Behavior t a) where
254+ fromString = pure . fromString
255+
236256instance Reflex t => Monad (Behavior t) where
237257 a >>= f = pull $ sample a >>= sample . f
238258 -- 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.
239259 return = constant
240260 fail = error "Monad (Behavior t) does not support fail"
241261
262+instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
263+ mempty = constant mempty
264+ mappend a b = pull $ liftM2 mappend (sample a) (sample b)
265+ mconcat = pull . fmap mconcat . mapM sample
266+
267+instance (Reflex t, Num a) => Num (Behavior t a) where
268+ (+) = liftA2 (+)
269+ (-) = liftA2 (-)
270+ (*) = liftA2 (*)
271+ abs = fmap abs
272+ fromInteger = pure . fromInteger
273+ negate = fmap negate
274+ signum = fmap signum
275+
242276instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
243277 a <> b = pull $ liftM2 (<>) (sample a) (sample b)
244278 sconcat = pull . fmap sconcat . mapM sample
@@ -248,11 +282,6 @@ instance (Reflex t, Semigroup a) => Semigroup (Behavior t a) where
248282 times1p n = fmap $ times1p n
249283#endif
250284
251−instance (Reflex t, Monoid a) => Monoid (Behavior t a) where
252− mempty = constant mempty
253− mappend a b = pull $ liftM2 mappend (sample a) (sample b)
254− mconcat = pull . fmap mconcat . mapM sample
255−
256285--TODO: See if there's a better class in the standard libraries already
257286-- | A class for values that combines filtering and mapping using 'Maybe'.
258287class FunctorMaybe f where
@@ -271,12 +300,30 @@ fforMaybe = flip fmapMaybe
271300ffilter :: FunctorMaybe f => (a -> Bool) -> f a -> f a
272301ffilter f = fmapMaybe $ \x -> if f x then Just x else Nothing
273302
274−instance Reflex t => FunctorMaybe (Event t) where
275− fmapMaybe f = push $ return . f
303+-- | Left-biased event union (prefers left event on simultaneous
304+-- occurrence).
305+instance Reflex t => Alt (Event t) where
306+ ev1 <!> ev2 = leftmost [ev1, ev2]
307+
308+-- | Event intersection (convenient interface to 'coincidence').
309+instance Reflex t => Apply (Event t) where
310+ evf <.> evx = coincidence (fmap (<$> evx) evf)
311+
312+-- | Event intersection (convenient interface to 'coincidence').
313+instance Reflex t => Bind (Event t) where
314+ evx >>- f = coincidence (f <$> evx)
315+ join = coincidence
276316
277317instance Reflex t => Functor (Event t) where
278318 fmap f = fmapMaybe $ Just . f
279319
320+instance Reflex t => FunctorMaybe (Event t) where
321+ fmapMaybe f = push $ return . f
322+
323+-- | Never: @'zero' = 'never'@.
324+instance Reflex t => Plus (Event t) where
325+ zero = never
326+
280327-- | Replace each occurrence value of the 'Event' with the value of the
281328-- 'Behavior' at the time of that occurrence.
282329tag :: Reflex t => Behavior t b -> Event t a -> Event t b