727d391 · patch · 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.Base,

73 Reflex.PostBuild.Base,

src/Reflex.hs+4−3

@@ -9,10 +9,11 @@ import Reflex.Dynamic as X

9import Reflex.Dynamic.TH as X

10import Reflex.Dynamic.Uniq as X

11import Reflex.DynamicWriter as X

12−import Reflex.PerformEvent.Class as X

13import Reflex.PerformEvent.Base as X

12import Reflex.PerformEvent.Base as X

14−import Reflex.PostBuild.Class as X

13+import Reflex.PerformEvent.Class as X

15import Reflex.PostBuild.Base as X

14import Reflex.PostBuild.Base as X

16−import Reflex.Requester.Class as X

15+import Reflex.PostBuild.Class as X

17import Reflex.Requester.Base as X

16import Reflex.Requester.Base as X

17+import Reflex.Requester.Class as X

18import Reflex.Spider as X

19+import Reflex.TriggerEvent.Class as X

src/Reflex/DynamicWriter.hs+1−1

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

7{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8{-# LANGUAGE LambdaCase #-}

9{-# LANGUAGE MultiParamTypeClasses #-}

10−{-# LANGUAGE RecursiveDo #-}

11{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE ScopedTypeVariables #-}

12{-# LANGUAGE TypeFamilies #-}

11{-# LANGUAGE TypeFamilies #-}

13{-# LANGUAGE UndecidableInstances #-}

12{-# LANGUAGE UndecidableInstances #-}

@@ -40,6 +39,7 @@ import Reflex.Host.Class

40import Reflex.PerformEvent.Class

39import Reflex.PerformEvent.Class

41import Reflex.PostBuild.Class

40import Reflex.PostBuild.Class

42import Reflex.Requester.Class

41import Reflex.Requester.Class

42+import Reflex.TriggerEvent.Class

43

44instance MonadTrans (DynamicWriterT t w) where

45 lift = DynamicWriterT . lift

src/Reflex/PerformEvent/Base.hs−1

@@ -10,7 +10,6 @@

10{-# LANGUAGE PartialTypeSignatures #-}

11{-# LANGUAGE PolyKinds #-}

12{-# LANGUAGE RankNTypes #-}

13−{-# LANGUAGE RecursiveDo #-}

14{-# LANGUAGE ScopedTypeVariables #-}

13{-# LANGUAGE ScopedTypeVariables #-}

15{-# LANGUAGE StandaloneDeriving #-}

14{-# LANGUAGE StandaloneDeriving #-}

16{-# LANGUAGE TypeFamilies #-}

15{-# LANGUAGE TypeFamilies #-}

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

@@ -14,10 +14,10 @@

14module Reflex.PerformEvent.Class

15 ( PerformEvent (..)

16 , performEventAsync

17− , TriggerEvent (..)

18 ) where

17 ) where

19

18

20import Reflex.Class

19import Reflex.Class

20+import Reflex.TriggerEvent.Class

21

22import Control.Monad.Reader

23

@@ -36,26 +36,6 @@ class (Reflex t, Monad (Performable m), Monad m) => PerformEvent t m | m -> t wh

36 -- better performance.

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

38

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

40−-- | 'TriggerEvent' represents actions that can create 'Event's that can be

41−-- triggered from the IO monad.

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

43− -- | Create a triggerable 'Event'. Whenever the resulting function is called,

44− -- the resulting 'Event' will fire at some point in the future. Note that

45− -- this may not be synchronous.

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

47− -- | Like 'newTriggerEvent', but the callback itself takes another callback,

48− -- to be invoked once the requested 'Event' occurrence has finished firing.

49− -- This allows synchronous operation.

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

51− -- | Like 'newTriggerEventWithOnComplete', but with setup and teardown. This

52− -- relatively complex type signature allows any external listeners to be

53− -- subscribed lazily and then removed whenever the returned 'Event' is no

54− -- longer being listened to. Note that the setup/teardown may happen multiple

55− -- times, and there is no guarantee that the teardown will be executed

56− -- promptly, or even at all, in the case of program termination.

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

58−

59-- | Like 'performEvent', but the resulting 'Event' occurs only when the

39-- | Like 'performEvent', but the resulting 'Event' occurs only when the

60-- callback (@a -> IO ()@) is called, not when the included action finishes.

40-- callback (@a -> IO ()@) is called, not when the included action finishes.

61--

41--

@@ -79,8 +59,3 @@ instance PerformEvent t m => PerformEvent t (ReaderT r m) where

79 performEvent e = do

59 performEvent e = do

80 r <- ask

60 r <- ask

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

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

82−

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

84− newTriggerEvent = lift newTriggerEvent

85− newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

86− newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete

src/Reflex/PostBuild/Base.hs+1−1

@@ -3,7 +3,6 @@

3{-# LANGUAGE CPP #-}

4{-# LANGUAGE DataKinds #-}

5{-# LANGUAGE FlexibleInstances #-}

6−{-# LANGUAGE FunctionalDependencies #-}

7{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

9{-# LANGUAGE RecursiveDo #-}

8{-# LANGUAGE RecursiveDo #-}

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

23import Reflex.Host.Class

22import Reflex.Host.Class

24import Reflex.PerformEvent.Class

23import Reflex.PerformEvent.Class

25import Reflex.PostBuild.Class

24import Reflex.PostBuild.Class

25+import Reflex.TriggerEvent.Class

26

27import Control.Monad.Exception

28import Control.Monad.Primitive

src/Reflex/PostBuild/Class.hs−2

@@ -4,9 +4,7 @@

4{-# LANGUAGE DataKinds #-}

5{-# LANGUAGE FlexibleInstances #-}

6{-# LANGUAGE FunctionalDependencies #-}

7−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

9−{-# LANGUAGE RecursiveDo #-}

10{-# LANGUAGE ScopedTypeVariables #-}

8{-# LANGUAGE ScopedTypeVariables #-}

11{-# LANGUAGE TypeFamilies #-}

9{-# LANGUAGE TypeFamilies #-}

12{-# LANGUAGE TypeOperators #-}

10{-# LANGUAGE TypeOperators #-}

src/Reflex/Requester/Base.hs+1

@@ -25,6 +25,7 @@ import Reflex.Host.Class

25import Reflex.PerformEvent.Class

26import Reflex.PostBuild.Class

27import Reflex.Requester.Class

28+import Reflex.TriggerEvent.Class

28

29

29import Control.Monad.Exception

30import Control.Monad.Exception

30import Control.Monad.Identity

31import Control.Monad.Identity

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

@@ -0,0 +1,113 @@

1+{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE MultiParamTypeClasses #-}

5+{-# LANGUAGE TypeFamilies #-}

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.Class

17+import Reflex.PostBuild.Class

18+import Reflex.TriggerEvent.Class

19+

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

21+

22+newtype EventTriggerRef t m a = EventTriggerRef { unEventTriggerRef :: Ref m (Maybe (EventTrigger t a)) }

23+

24+newtype TriggerEventT t m a = TriggerEventT

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

26+ } deriving ( Functor

27+ , Applicative

28+ , Monad

29+ , MonadFix

30+ , MonadIO

31+ , MonadException

32+ , MonadAsyncException

33+ )

34+

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

36+runTriggerEventT = runReaderT . unTriggerEventT

37+

38+instance MonadTrans (TriggerEventT t) where

39+ lift = TriggerEventT . lift

40+

41+instance PerformEvent t m =>

42+ PerformEvent t (TriggerEventT t m) where

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

44+ performEvent_ e = lift $ performEvent_ e

45+ {-# INLINABLE performEvent_ #-}

46+ performEvent e = lift $ performEvent e

47+ {-# INLINABLE performEvent #-}

48+

49+instance PostBuild t m =>

50+ PostBuild t (TriggerEventT t m) where

51+ getPostBuild = lift getPostBuild

52+ {-# INLINABLE getPostBuild #-}

53+

54+instance MonadReflexCreateTrigger t m =>

55+ MonadReflexCreateTrigger t (TriggerEventT t m) where

56+ newEventWithTrigger = lift . newEventWithTrigger

57+ {-# INLINABLE newEventWithTrigger #-}

58+ newFanEventWithTrigger f = lift $ newFanEventWithTrigger f

59+ {-# INLINABLE newFanEventWithTrigger #-}

60+

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

62+ TriggerEvent t (TriggerEventT t m) where

63+ newTriggerEvent = do

64+ (e, t) <- newTriggerEventWithOnComplete

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

66+ {-# INLINABLE newTriggerEvent #-}

67+ newTriggerEventWithOnComplete = do

68+ events <- askEvents

69+ (eResult, reResultTrigger) <- lift newEventWithTriggerRef

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

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

72+ {-# INLINABLE newTriggerEventWithOnComplete #-}

73+ newEventWithLazyTriggerWithOnComplete f = do

74+ events <- askEvents

75+ lift . newEventWithTrigger $ \t ->

76+ f $ \a cb -> do

77+ reResultTrigger <- newRef $ Just t

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

79+ {-# INLINABLE newEventWithLazyTriggerWithOnComplete #-}

80+

81+instance MonadRef m =>

82+ MonadRef (TriggerEventT t m) where

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

84+ newRef = lift . newRef

85+ {-# INLINABLE newRef #-}

86+ readRef = lift . readRef

87+ {-# INLINABLE readRef #-}

88+ writeRef r = lift . writeRef r

89+ {-# INLINABLE writeRef #-}

90+

91+instance MonadAtomicRef m =>

92+ MonadAtomicRef (TriggerEventT t m) where

93+ atomicModifyRef r = lift . atomicModifyRef r

94+ {-# INLINABLE atomicModifyRef #-}

95+

96+instance MonadSample t m =>

97+ MonadSample t (TriggerEventT t m) where

98+ sample = lift . sample

99+ {-# INLINABLE sample #-}

100+

101+instance MonadHold t m =>

102+ MonadHold t (TriggerEventT t m) where

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

104+ {-# INLINABLE hold #-}

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

106+ {-# INLINABLE holdDyn #-}

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

108+ {-# INLINABLE holdIncremental #-}

109+

110+askEvents

111+ :: Monad m

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

113+askEvents = TriggerEventT ask

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

@@ -0,0 +1,37 @@

1+{-# LANGUAGE FlexibleInstances #-}

2+{-# LANGUAGE FunctionalDependencies #-}

3+{-# LANGUAGE MultiParamTypeClasses #-}

4+{-# LANGUAGE UndecidableInstances #-}

5+

6+module Reflex.TriggerEvent.Class

7+ ( TriggerEvent (..)

8+ ) where

9+

10+import Reflex.Class

11+

12+import Control.Monad.Reader

13+

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

15+-- | 'TriggerEvent' represents actions that can create 'Event's that can be

16+-- triggered from the IO monad.

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

18+ -- | Create a triggerable 'Event'. Whenever the resulting function is called,

19+ -- the resulting 'Event' will fire at some point in the future. Note that

20+ -- this may not be synchronous.

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

22+ -- | Like 'newTriggerEvent', but the callback itself takes another callback,

23+ -- to be invoked once the requested 'Event' occurrence has finished firing.

24+ -- This allows synchronous operation.

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

26+ -- | Like 'newTriggerEventWithOnComplete', but with setup and teardown. This

27+ -- relatively complex type signature allows any external listeners to be

28+ -- subscribed lazily and then removed whenever the returned 'Event' is no

29+ -- longer being listened to. Note that the setup/teardown may happen multiple

30+ -- times, and there is no guarantee that the teardown will be executed

31+ -- promptly, or even at all, in the case of program termination.

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

33+

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

35+ newTriggerEvent = lift newTriggerEvent

36+ newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete

37+ newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete