11a4ce7 · reflex · git.iko.soy

reflex.cabal+2

compare with develop

unifiedsplit

@@ -66,6 +66,8 @@ library

66 Reflex.Host.Class,

67 Reflex.Optimizer,

68 Reflex.Patch,

69+ Reflex.TriggerEvent.Base,

70+ Reflex.TriggerEvent.Class,

69 Reflex.PerformEvent.Base,

71 Reflex.PerformEvent.Base,

70 Reflex.PerformEvent.Class,

72 Reflex.PerformEvent.Class,

71 Reflex.PostBuild.Class,

73 Reflex.PostBuild.Class,

src/Reflex.hs+1

@@ -10,3 +10,4 @@ import Reflex.DynamicWriter as X

10import Reflex.PerformEvent.Class as X

11import Reflex.PostBuild.Class as X

12import Reflex.Spider as X

13+import Reflex.TriggerEvent.Class as X

src/Reflex/DynamicWriter.hs+1

@@ -32,6 +32,7 @@ import Reflex.Class

32import Reflex.Dynamic

33import Reflex.Host.Class

34import Reflex.PerformEvent.Class

35+import Reflex.TriggerEvent.Class

35import Reflex.PostBuild.Class

36import Reflex.PostBuild.Class

36

37

37instance MonadTrans (DynamicWriterT t w) where

38instance MonadTrans (DynamicWriterT t w) where

src/Reflex/PerformEvent/Base.hs+1

@@ -22,6 +22,7 @@ import Reflex.Class

22import Reflex.Host.Class

23import Reflex.PerformEvent.Class

24import Reflex.PostBuild.Class

25+import Reflex.TriggerEvent.Class

25

26

26import Control.Lens

27import Control.Lens

27import Control.Monad.Exception

28import Control.Monad.Exception

src/Reflex/PerformEvent/Class.hs+1−11

@@ -11,6 +11,7 @@

11module Reflex.PerformEvent.Class where

12

13import Reflex.Class

14+import Reflex.TriggerEvent.Class

14

15

15import Control.Monad.Identity

16import Control.Monad.Identity

16import Control.Monad.Reader

17import Control.Monad.Reader

@@ -22,12 +23,6 @@ class (Reflex t, Monad (Performable m), Monad m) => PerformEvent t m | m -> t wh

22 performEvent :: Event t (Performable m a) -> m (Event t a)

23 performEvent :: Event t (Performable m a) -> m (Event t a)

23 performEvent_ :: Event t (Performable m ()) -> m ()

24 performEvent_ :: Event t (Performable m ()) -> m ()

24

25

25−--TODO: Shouldn't have IO hard-coded

26−class Monad m => TriggerEvent t m | m -> t where

27− newTriggerEvent :: m (Event t a, a -> IO ())

28− newTriggerEventWithOnComplete :: m (Event t a, a -> IO () -> IO ()) --TODO: This and newTriggerEvent should be unified somehow

29− newEventWithLazyTriggerWithOnComplete :: ((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)

30−

31class (Reflex t, Monad m) => MonadRequest t m | m -> t where

26class (Reflex t, Monad m) => MonadRequest t m | m -> t where

32 type Request m :: * -> *

27 type Request m :: * -> *

33 type Response m :: * -> *

28 type Response m :: * -> *

@@ -49,11 +44,6 @@ instance PerformEvent t m => PerformEvent t (ReaderT r m) where

49 r <- ask

44 r <- ask

50 lift $ performEvent $ flip runReaderT r <$> e

45 lift $ performEvent $ flip runReaderT r <$> e

51

46

52−instance TriggerEvent t m => TriggerEvent t (ReaderT r m) where

53− newTriggerEvent = lift newTriggerEvent

54− newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

55− newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

56−

57instance MonadRequest t m => MonadRequest t (ReaderT r m) where

47instance MonadRequest t m => MonadRequest t (ReaderT r m) where

58 type Request (ReaderT r m) = Request m

48 type Request (ReaderT r m) = Request m

59 type Response (ReaderT r m) = Response m

49 type Response (ReaderT r m) = Response m

src/Reflex/PostBuild/Class.hs+1

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

23import Reflex.Class

24import Reflex.Host.Class

25import Reflex.PerformEvent.Class

26+import Reflex.TriggerEvent.Class

26

27

27class (Reflex t, Monad m) => PostBuild t m | m -> t where

28class (Reflex t, Monad m) => PostBuild t m | m -> t where

28 getPostBuild :: m (Event t ())

29 getPostBuild :: m (Event t ())

src/Reflex/TriggerEvent/Base.hsnew file+112

@@ -0,0 +1,112 @@

1+{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

4+{-# LANGUAGE TypeFamilies #-}

5+{-# LANGUAGE FlexibleInstances #-}

6+

7+module Reflex.TriggerEvent.Base where

8+

9+import Control.Concurrent

10+import Control.Monad.Exception

11+import Control.Monad.Reader

12+import Control.Monad.Ref

13+import Data.Dependent.Sum

14+import Reflex.Class

15+import Reflex.Host.Class

16+import Reflex.PerformEvent.Base

17+import Reflex.PerformEvent.Class

18+import Reflex.PostBuild.Class

19+import Reflex.TriggerEvent.Class

20+

21+data TriggerInvocation a = TriggerInvocation a (IO ())

22+

23+newtype TriggerEventT t m a = TriggerEventT

24+ { unTriggerEventT :: ReaderT (Chan [DSum (EventTriggerRef t m) TriggerInvocation]) m a

25+ } deriving ( Functor

26+ , Applicative

27+ , Monad

28+ , MonadFix

29+ , MonadIO

30+ , MonadException

31+ , MonadAsyncException

32+ )

33+

34+runTriggerEventT :: TriggerEventT t m a -> Chan [DSum (EventTriggerRef t m) TriggerInvocation] -> m a

35+runTriggerEventT = runReaderT . unTriggerEventT

36+

37+instance MonadTrans (TriggerEventT t) where

38+ lift = TriggerEventT . lift

39+

40+instance PerformEvent t m =>

41+ PerformEvent t (TriggerEventT t m) where

42+ type Performable (TriggerEventT t m) = Performable m

43+ performEvent_ e = lift $ performEvent_ e

44+ {-# INLINABLE performEvent_ #-}

45+ performEvent e = lift $ performEvent e

46+ {-# INLINABLE performEvent #-}

47+

48+instance PostBuild t m =>

49+ PostBuild t (TriggerEventT t m) where

50+ getPostBuild = lift getPostBuild

51+ {-# INLINABLE getPostBuild #-}

52+

53+instance MonadReflexCreateTrigger t m =>

54+ MonadReflexCreateTrigger t (TriggerEventT t m) where

55+ newEventWithTrigger = lift . newEventWithTrigger

56+ {-# INLINABLE newEventWithTrigger #-}

57+ newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

58+ {-# INLINABLE newFanEventWithTrigger #-}

59+

60+instance (Monad m, MonadRef m, Ref m ~ Ref IO, MonadReflexCreateTrigger t m) =>

61+ TriggerEvent t (TriggerEventT t m) where

62+ newTriggerEvent = do

63+ (e, t) <- newTriggerEventWithOnComplete

64+ return (e, \a -> t a $ return ())

65+ {-# INLINABLE newTriggerEvent #-}

66+ newTriggerEventWithOnComplete = do

67+ events <- askEvents

68+ (eResult, reResultTrigger) <- lift newEventWithTriggerRef

69+ return . (,) eResult $ \a cb ->

70+ writeChan events [EventTriggerRef reResultTrigger :=> TriggerInvocation a cb]

71+ {-# INLINABLE newTriggerEventWithOnComplete #-}

72+ newEventWithLazyTriggerWithOnComplete f = do

73+ events <- askEvents

74+ lift . newEventWithTrigger $ \t ->

75+ f $ \a cb -> do

76+ reResultTrigger <- newRef $ Just t

77+ writeChan events [EventTriggerRef reResultTrigger :=> TriggerInvocation a cb]

78+ {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}

79+

80+instance MonadRef m =>

81+ MonadRef (TriggerEventT t m) where

82+ type Ref (TriggerEventT t m) = Ref m

83+ newRef = lift . newRef

84+ {-# INLINABLE newRef #-}

85+ readRef = lift . readRef

86+ {-# INLINABLE readRef #-}

87+ writeRef r = lift . writeRef r

88+ {-# INLINABLE writeRef #-}

89+

90+instance MonadAtomicRef m =>

91+ MonadAtomicRef (TriggerEventT t m) where

92+ atomicModifyRef r = lift . atomicModifyRef r

93+ {-# INLINABLE atomicModifyRef #-}

94+

95+instance MonadSample t m =>

96+ MonadSample t (TriggerEventT t m) where

97+ sample = lift . sample

98+ {-# INLINABLE sample #-}

99+

100+instance MonadHold t m =>

101+ MonadHold t (TriggerEventT t m) where

102+ hold v0 v' = lift $ hold v0 v'

103+ {-# INLINABLE hold #-}

104+ holdDyn v0 v' = lift $ holdDyn v0 v'

105+ {-# INLINABLE holdDyn #-}

106+ holdIncremental v0 v' = lift $ holdIncremental v0 v'

107+ {-# INLINABLE holdIncremental #-}

108+

109+askEvents

110+ :: Monad m

111+ => TriggerEventT t m (Chan [DSum (EventTriggerRef t m) TriggerInvocation])

112+askEvents = TriggerEventT ask

src/Reflex/TriggerEvent/Class.hsnew file+22

@@ -0,0 +1,22 @@

1+{-# LANGUAGE UndecidableInstances #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE FunctionalDependencies #-}

4+{-# LANGUAGE MultiParamTypeClasses #-}

5+

6+module Reflex.TriggerEvent.Class where

7+

8+import Reflex.Class

9+

10+import Control.Monad.Reader

11+

12+--TODO: Shouldn't have IO hard-coded

13+class Monad m => TriggerEvent t m | m -> t where

14+ newTriggerEvent :: m (Event t a, a -> IO ())

15+ newTriggerEventWithOnComplete :: m (Event t a, a -> IO () -> IO ()) --TODO: This and newTriggerEvent should be unified somehow

16+ newEventWithLazyTriggerWithOnComplete :: ((a -> IO () -> IO ()) -> IO (IO ())) -> m (Event t a)

17+

18+instance TriggerEvent t m => TriggerEvent t (ReaderT r m) where

19+ newTriggerEvent = lift newTriggerEvent

20+ newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

21+ newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

22+