9f65e34 · reflex · git.iko.soy

git.iko.soy/reflex

on develop help sign in

Add Monoid and Semigroup instances

9f65e343noch9 years ago

src/Reflex/PerformEvent/Base.hs+3

compare with develop

unifiedsplit

@@ -43,6 +43,7 @@ import Data.Dependent.Sum

43import Data.FastMutableIntMap

44import Data.IntMap.Strict (IntMap)

45import qualified Data.IntMap.Strict as IntMap

46+import qualified Data.Semigroup as S

47-- | A function that fires events for the given 'EventTrigger's and then runs

48-- | A function that fires events for the given 'EventTrigger's and then runs

48-- any followup actions provided via 'PerformEvent'. The given 'ReadPhase'

49-- any followup actions provided via 'PerformEvent'. The given 'ReadPhase'

@@ -60,6 +61,8 @@ deriving instance ReflexHost t => Monad (PerformEventT t m)

60deriving instance ReflexHost t => MonadFix (PerformEventT t m)

61deriving instance ReflexHost t => MonadFix (PerformEventT t m)

61deriving instance (ReflexHost t, MonadIO (HostFrame t)) => MonadIO (PerformEventT t m)

62deriving instance (ReflexHost t, MonadIO (HostFrame t)) => MonadIO (PerformEventT t m)

62deriving instance (ReflexHost t, MonadException (HostFrame t)) => MonadException (PerformEventT t m)

63deriving instance (ReflexHost t, MonadException (HostFrame t)) => MonadException (PerformEventT t m)

64+deriving instance (ReflexHost t, Applicative m, Monoid a) => Monoid (PerformEventT t m a)

65+deriving instance (ReflexHost t, Applicative m, S.Semigroup a) => S.Semigroup (PerformEventT t m a)

64instance (PrimMonad (HostFrame t), ReflexHost t) => PrimMonad (PerformEventT t m) where

67instance (PrimMonad (HostFrame t), ReflexHost t) => PrimMonad (PerformEventT t m) where

65 type PrimState (PerformEventT t m) = PrimState (HostFrame t)

68 type PrimState (PerformEventT t m) = PrimState (HostFrame t)

src/Reflex/PostBuild/Base.hs+10

@@ -28,6 +28,7 @@ import Reflex.PerformEvent.Class

28import Reflex.PostBuild.Class

29import Reflex.TriggerEvent.Class

31+import Control.Applicative (liftA2)

31import Control.Monad.Exception

32import Control.Monad.Exception

32import Control.Monad.Identity

33import Control.Monad.Identity

33import Control.Monad.Primitive

34import Control.Monad.Primitive

@@ -39,6 +40,7 @@ import qualified Data.Dependent.Map as DMap

39import Data.Functor.Compose

40import Data.Functor.Compose

40import Data.IntMap.Strict (IntMap)

41import Data.IntMap.Strict (IntMap)

41import qualified Data.IntMap.Strict as IntMap

42import qualified Data.IntMap.Strict as IntMap

43+import qualified Data.Semigroup as S

43-- | Provides a basic implementation of 'PostBuild'.

45-- | Provides a basic implementation of 'PostBuild'.

44newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadTrans, MonadException, MonadAsyncException)

46newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadTrans, MonadException, MonadAsyncException)

@@ -50,6 +52,14 @@ newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a

50runPostBuildT :: PostBuildT t m a -> Event t () -> m a

52runPostBuildT :: PostBuildT t m a -> Event t () -> m a

51runPostBuildT (PostBuildT a) = runReaderT a

53runPostBuildT (PostBuildT a) = runReaderT a

55+-- TODO: Monoid and Semigroup can likely be derived once ReaderT has them.

56+instance (Monoid a, Applicative m) => Monoid (PostBuildT t m a) where

57+ mempty = pure mempty

58+ mappend = liftA2 mappend

59+

60+instance (S.Semigroup a, Applicative m) => S.Semigroup (PostBuildT t m a) where

61+ (<>) = liftA2 (S.<>)

62+

53instance PrimMonad m => PrimMonad (PostBuildT x m) where

63instance PrimMonad m => PrimMonad (PostBuildT x m) where

54 type PrimState (PostBuildT x m) = PrimState m

64 type PrimState (PostBuildT x m) = PrimState m

55 primitive = lift . primitive

65 primitive = lift . primitive

src/Reflex/Query/Base.hs+11

@@ -16,6 +16,7 @@ module Reflex.Query.Base

16 , withQueryT

17 ) where

19+import Control.Applicative (liftA2)

19import Control.Monad.Exception

20import Control.Monad.Exception

20import Control.Monad.Fix

21import Control.Monad.Fix

21import Control.Monad.Reader

22import Control.Monad.Reader

@@ -30,6 +31,7 @@ import Data.Functor.Misc

30import Data.Map (Map)

31import Data.Map (Map)

31import qualified Data.Map as Map

32import qualified Data.Map as Map

32import Data.Monoid

33import Data.Monoid

34+import qualified Data.Semigroup as S

33import Data.Some (Some)

35import Data.Some (Some)

34import qualified Data.Some as Some

36import qualified Data.Some as Some

35import Data.These

37import Data.These

@@ -210,6 +212,15 @@ instance MonadReflexCreateTrigger t m => MonadReflexCreateTrigger t (QueryT t q

210 newEventWithTrigger = QueryT . newEventWithTrigger

212 newEventWithTrigger = QueryT . newEventWithTrigger

211 newFanEventWithTrigger a = QueryT . lift $ newFanEventWithTrigger a

213 newFanEventWithTrigger a = QueryT . lift $ newFanEventWithTrigger a

212

214

215+-- TODO: Monoid and Semigroup can likely be derived once StateT has them.

216+instance (Monoid a, Monad m) => Monoid (QueryT t q m a) where

217+ mempty = pure mempty

218+ mappend = liftA2 mappend

219+

220+instance (S.Semigroup a, Monad m) => S.Semigroup (QueryT t q m a) where

221+ (<>) = liftA2 (S.<>)

222+

223+

213mapQuery :: QueryMorphism q q' -> q -> q'

224mapQuery :: QueryMorphism q q' -> q -> q'

214mapQuery = _queryMorphism_mapQuery

225mapQuery = _queryMorphism_mapQuery

215

226

src/Reflex/Requester/Base.hs+11

@@ -40,6 +40,7 @@ import Reflex.PostBuild.Class

40import Reflex.Requester.Class

41import Reflex.TriggerEvent.Class

43+import Control.Applicative (liftA2)

43import Control.Monad.Exception

44import Control.Monad.Exception

44import Control.Monad.Identity

45import Control.Monad.Identity

45import Control.Monad.Reader

46import Control.Monad.Reader

@@ -59,6 +60,7 @@ import Data.Map (Map)

59import qualified Data.Map as Map

60import qualified Data.Map as Map

60import Data.Monoid ((<>))

61import Data.Monoid ((<>))

61import Data.Unique.Tag

62import Data.Unique.Tag

63+import qualified Data.Semigroup as S

62import Data.Some (Some)

64import Data.Some (Some)

63import Data.Type.Equality

65import Data.Type.Equality

64import Data.Proxy

66import Data.Proxy

@@ -238,6 +240,15 @@ deriving instance MonadHold t m => MonadHold t (RequesterT t request response m)

238deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)

240deriving instance PostBuild t m => PostBuild t (RequesterT t request response m)

239deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)

241deriving instance TriggerEvent t m => TriggerEvent t (RequesterT t request response m)

240

242

243+-- TODO: Monoid and Semigroup can likely be derived once StateT has them.

244+instance (Monoid a, Monad m) => Monoid (RequesterT t request response m a) where

245+ mempty = pure mempty

246+ mappend = liftA2 mappend

247+

248+instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response m a) where

249+ (<>) = liftA2 (S.<>)

250+

251+

241-- | Run a 'RequesterT' action. The resulting 'Event' will fire whenever

252-- | Run a 'RequesterT' action. The resulting 'Event' will fire whenever

242-- requests are made, and responses should be provided in the input 'Event'.

253-- requests are made, and responses should be provided in the input 'Event'.

243-- The 'Tag' keys will be used to return the responses to the same place the

254-- The 'Tag' keys will be used to return the responses to the same place the

src/Reflex/TriggerEvent/Base.hs+11

@@ -13,6 +13,7 @@ module Reflex.TriggerEvent.Base

13 , EventTriggerRef (..)

14 ) where

16+import Control.Applicative (liftA2)

16import Control.Concurrent

17import Control.Concurrent

17import Control.Monad.Exception

18import Control.Monad.Exception

18import Control.Monad.Primitive

19import Control.Monad.Primitive

@@ -21,6 +22,7 @@ import Control.Monad.Ref

21import Data.Coerce

22import Data.Coerce

22import Data.Dependent.Sum

23import Data.Dependent.Sum

23import Data.IORef

24import Data.IORef

25+import qualified Data.Semigroup as S

24import Reflex.Class

26import Reflex.Class

25import Reflex.Host.Class

27import Reflex.Host.Class

26import Reflex.PerformEvent.Class

28import Reflex.PerformEvent.Class

@@ -129,6 +131,15 @@ instance Adjustable t m => Adjustable t (TriggerEventT t m) where

129 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}

131 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}

130 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = TriggerEventT $ traverseDMapWithKeyWithAdjustWithMove (coerce . f) dm0 dm'

132 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = TriggerEventT $ traverseDMapWithKeyWithAdjustWithMove (coerce . f) dm0 dm'

131

133

134+-- TODO: Monoid and Semigroup can likely be derived once ReaderT has them.

135+instance (Monoid a, Applicative m) => Monoid (TriggerEventT t m a) where

136+ mempty = pure mempty

137+ mappend = liftA2 mappend

138+

139+instance (S.Semigroup a, Applicative m) => S.Semigroup (TriggerEventT t m a) where

140+ (<>) = liftA2 (S.<>)

141+

142+

132-- | Retrieve the current 'Chan'; event trigger invocations pushed into it will

143-- | Retrieve the current 'Chan'; event trigger invocations pushed into it will

133-- be fired.

144-- be fired.

134askEvents :: Monad m => TriggerEventT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])

145askEvents :: Monad m => TriggerEventT t m (Chan [DSum (EventTriggerRef t) TriggerInvocation])