9bfe802 · reflex · git.iko.soy

git.iko.soy/reflex

Merge pull request #142 from reflex-frp/postbuildt-monoid

Add Monoid and Semigroup instances

commit9bfe802062363f60d12ceffb90df056a3e211936 authorRyan Trinkle <ryan.trinkle@gmail.com> dateWed 3 Jan 2018, 22:41 (9 years ago) parentc56abf2 9f65e34

5 files changed+46

compare with develop

unifiedsplit

src/Reflex/PerformEvent/Base.hs+3 src/Reflex/PostBuild/Base.hs+10 src/Reflex/Query/Base.hs+11 src/Reflex/Requester/Base.hs+11 src/Reflex/TriggerEvent/Base.hs+11

src/Reflex/PerformEvent/Base.hs+3

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

4242import Data.Dependent.Sum

4343import Data.IntMap.Strict (IntMap)

4444import qualified Data.IntMap.Strict as IntMap

45+import qualified Data.Semigroup as S

4546

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

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

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

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

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

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

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

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

6265

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

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

src/Reflex/PostBuild/Base.hs+10

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

2828import Reflex.PostBuild.Class

2929import Reflex.TriggerEvent.Class

3030

31+import Control.Applicative (liftA2)

3132import Control.Monad.Exception

3233import Control.Monad.Identity

3334import Control.Monad.Primitive

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

3940import Data.Functor.Compose

4041import Data.IntMap.Strict (IntMap)

4142import qualified Data.IntMap.Strict as IntMap

43+import qualified Data.Semigroup as S

4244

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

4446newtype 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

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

5153runPostBuildT (PostBuildT a) = runReaderT a

5254

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+

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

5464 type PrimState (PostBuildT x m) = PrimState m

5565 primitive = lift . primitive

src/Reflex/Query/Base.hs+11

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

1616 , withQueryT

1717 ) where

1818

19+import Control.Applicative (liftA2)

1920import Control.Monad.Exception

2021import Control.Monad.Fix

2122import Control.Monad.Reader

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

3031import Data.Map (Map)

3132import qualified Data.Map as Map

3233import Data.Monoid

34+import qualified Data.Semigroup as S

3335import Data.Some (Some)

3436import qualified Data.Some as Some

3537import Data.These

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

210212 newEventWithTrigger = QueryT . newEventWithTrigger

211213 newFanEventWithTrigger a = QueryT . lift $ newFanEventWithTrigger a

212214

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+

213224mapQuery :: QueryMorphism q q' -> q -> q'

214225mapQuery = _queryMorphism_mapQuery

215226

src/Reflex/Requester/Base.hs+11

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

4040import Reflex.Requester.Class

4141import Reflex.TriggerEvent.Class

4242

43+import Control.Applicative (liftA2)

4344import Control.Monad.Exception

4445import Control.Monad.Identity

4546import Control.Monad.Reader

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

5859import qualified Data.Map as Map

5960import Data.Monoid ((<>))

6061import Data.Unique.Tag

62+import qualified Data.Semigroup as S

6163import Data.Some (Some)

6264import Data.Type.Equality

6365import Data.Proxy

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

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

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

239241

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

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

244+ mempty = pure mempty

245+ mappend = liftA2 mappend

246+

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

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

249+

250+

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

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

242253-- 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

1313 , EventTriggerRef (..)

1414 ) where

1515

16+import Control.Applicative (liftA2)

1617import Control.Concurrent

1718import Control.Monad.Exception

1819import Control.Monad.Primitive

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

2122import Data.Coerce

2223import Data.Dependent.Sum

2324import Data.IORef

25+import qualified Data.Semigroup as S

2426import Reflex.Class

2527import Reflex.Host.Class

2628import Reflex.PerformEvent.Class

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

129131 {-# INLINABLE traverseDMapWithKeyWithAdjustWithMove #-}

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

131133

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+

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

133144-- be fired.

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