git.iko.soy/reflex
on default-dynamic help sign in
reflex/src/Reflex/PostBuild/Class.hs
91 lines 3.4 kB history raw
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE FlexibleInstances #-}
3{-# LANGUAGE FunctionalDependencies #-}
4{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE ScopedTypeVariables #-}
7{-# LANGUAGE TypeFamilies #-}
8{-# LANGUAGE TypeOperators #-}
9{-# LANGUAGE UndecidableInstances #-}
10module Reflex.PostBuild.Class where
12import Control.Monad.Exception
13import Control.Monad.Reader
14import Control.Monad.Ref
15import Control.Monad.Trans.Control
16import Reflex.Class
17import Reflex.Deletable.Class
18import Reflex.Host.Class
19import Reflex.PerformEvent.Class
21class (Reflex t, Monad m) => PostBuild t m | m -> t where
22 getPostBuild :: m (Event t ())
24newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadTrans, MonadException, MonadAsyncException)
26instance MonadTransControl (PostBuildT t) where
27 type StT (PostBuildT t) a = StT (ReaderT (Event t ())) a
28 {-# INLINABLE liftWith #-}
29 liftWith = defaultLiftWith PostBuildT unPostBuildT
30 {-# INLINABLE restoreT #-}
31 restoreT = defaultRestoreT PostBuildT
33instance (Reflex t, Monad m) => PostBuild t (PostBuildT t m) where
34 {-# INLINABLE getPostBuild #-}
35 getPostBuild = PostBuildT ask
37instance Deletable t m => Deletable t (PostBuildT t m) where
38 {-# INLINABLE deletable #-}
39 deletable = liftThrough . deletable
41instance MonadSample t m => MonadSample t (PostBuildT t m) where
42 {-# INLINABLE sample #-}
43 sample = lift . sample
45instance MonadHold t m => MonadHold t (PostBuildT t m) where
46 {-# INLINABLE hold #-}
47 hold v0 = lift . hold v0
48 {-# INLINABLE holdDyn #-}
49 holdDyn v0 = lift . holdDyn v0
50 {-# INLINABLE holdIncremental #-}
51 holdIncremental v0 = lift . holdIncremental v0
53instance PerformEvent t m => PerformEvent t (PostBuildT t m) where
54 type Performable (PostBuildT t m) = PostBuildT t (Performable m)
55 {-# INLINABLE performEvent_ #-}
56 performEvent_ e = liftWith $ \run -> performEvent_ $ fmap run e
57 {-# INLINABLE performEvent #-}
58 performEvent e = liftWith $ \run -> performEvent $ fmap run e
60instance (ReflexHost t, MonadReflexCreateTrigger t m) => MonadReflexCreateTrigger t (PostBuildT t m) where
61 {-# INLINABLE newEventWithTrigger #-}
62 newEventWithTrigger = PostBuildT . lift . newEventWithTrigger
63 {-# INLINABLE newFanEventWithTrigger #-}
64 newFanEventWithTrigger f = PostBuildT $ lift $ newFanEventWithTrigger f
66instance TriggerEvent t m => TriggerEvent t (PostBuildT t m) where
67 {-# INLINABLE newTriggerEvent #-}
68 newTriggerEvent = lift newTriggerEvent
69 {-# INLINABLE newTriggerEventWithOnComplete #-}
70 newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete
71 newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete
73instance MonadRef m => MonadRef (PostBuildT t m) where
74 type Ref (PostBuildT t m) = Ref m
75 {-# INLINABLE newRef #-}
76 newRef = lift . newRef
77 {-# INLINABLE readRef #-}
78 readRef = lift . readRef
79 {-# INLINABLE writeRef #-}
80 writeRef r = lift . writeRef r
82instance MonadAtomicRef m => MonadAtomicRef (PostBuildT t m) where
83 {-# INLINABLE atomicModifyRef #-}
84 atomicModifyRef r = lift . atomicModifyRef r
86{-# INLINABLE runPostBuildT #-}
87runPostBuildT :: PostBuildT t m a -> Event t () -> m a
88runPostBuildT (PostBuildT a) = runReaderT a
90instance PostBuild t m => PostBuild t (ReaderT r m) where
91 getPostBuild = lift getPostBuild