@@ -0,0 +1,91 @@
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 #-}
10+module Reflex.PostBuild.Class where
11+
12+import Control.Monad.Exception
13+import Control.Monad.Reader
14+import Control.Monad.Ref
15+import Control.Monad.Trans.Control
16+import Reflex
17+import Reflex.Deletable.Class
18+import Reflex.Host.Class
19+import Reflex.PerformEvent.Class
20+
21+class (Reflex t, Monad m) => PostBuild t m | m -> t where
22+ getPostBuild :: m (Event t ())
23+
24+newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadTrans, MonadException, MonadAsyncException)
25+
26+instance 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
32+
33+instance (Reflex t, Monad m) => PostBuild t (PostBuildT t m) where
34+ {-# INLINABLE getPostBuild #-}
35+ getPostBuild = PostBuildT ask
36+
37+instance Deletable t m => Deletable t (PostBuildT t m) where
38+ {-# INLINABLE deletable #-}
39+ deletable = liftThrough . deletable
40+
41+instance MonadSample t m => MonadSample t (PostBuildT t m) where
42+ {-# INLINABLE sample #-}
43+ sample = lift . sample
44+
45+instance 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
52+
53+instance 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
59+
60+instance (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
65+
66+instance 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
72+
73+instance 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
81+
82+instance MonadAtomicRef m => MonadAtomicRef (PostBuildT t m) where
83+ {-# INLINABLE atomicModifyRef #-}
84+ atomicModifyRef r = lift . atomicModifyRef r
85+
86+{-# INLINABLE runPostBuildT #-}
87+runPostBuildT :: PostBuildT t m a -> Event t () -> m a
88+runPostBuildT (PostBuildT a) = runReaderT a
89+
90+instance PostBuild t m => PostBuild t (ReaderT r m) where
91+ getPostBuild = lift getPostBuild