@@ -1,128 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE RecursiveDo #-}
7−{-# LANGUAGE ScopedTypeVariables #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE TypeOperators #-}
10−{-# LANGUAGE UndecidableInstances #-}
11−module Reflex.Dom.PostBuild.Class where
12−
13−import Control.Lens hiding (element)
14−import Control.Monad.Exception
15−import Control.Monad.Reader
16−import Control.Monad.Ref
17−import Control.Monad.Trans.Control
18−import Foreign.JavaScript.TH
19−import Reflex
20−import Reflex.Dom.Builder.Class
21−import Reflex.PerformEvent.Class
22−import Reflex.Host.Class
23−
24−class (Reflex t, Monad m) => PostBuild t m | m -> t where
25− getPostBuild :: m (Event t ())
26−
27−newtype PostBuildT t m a = PostBuildT { unPostBuildT :: ReaderT (Event t ()) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadTrans, MonadException, MonadAsyncException)
28−
29−instance MonadTransControl (PostBuildT t) where
30− type StT (PostBuildT t) a = StT (ReaderT (Event t ())) a
31− {-# INLINABLE liftWith #-}
32− liftWith = defaultLiftWith PostBuildT unPostBuildT
33− {-# INLINABLE restoreT #-}
34− restoreT = defaultRestoreT PostBuildT
35−
36−instance (Reflex t, Monad m) => PostBuild t (PostBuildT t m) where
37− {-# INLINABLE getPostBuild #-}
38− getPostBuild = PostBuildT ask
39−
40−instance Deletable t m => Deletable t (PostBuildT t m) where
41− {-# INLINABLE deletable #-}
42− deletable = liftThrough . deletable
43−
44−{-# INLINABLE liftPostBuildTElementConfig #-}
45−liftPostBuildTElementConfig :: ElementConfig er t (PostBuildT t m) -> ElementConfig er t m
46−liftPostBuildTElementConfig cfg = cfg
47− { _elementConfig_eventSpec = _elementConfig_eventSpec cfg
48− }
49−
50−instance (DomBuilder t m, PerformEvent t m, MonadFix m, MonadHold t m) => DomBuilder t (PostBuildT t m) where
51− type DomBuilderSpace (PostBuildT t m) = DomBuilderSpace m
52− {-# INLINABLE textNode #-}
53− textNode = lift . textNode
54− {-# INLINABLE element #-}
55− element t cfg child = liftWith $ \run -> element t (liftPostBuildTElementConfig cfg) $ run child
56− {-# INLINABLE placeholder #-}
57− placeholder cfg = lift $ do
58− rec childPostBuild <- deletable (_placeholder_deletedSelf p) $ performEvent $ return () <$ _placeholder_insertedAbove p
59− p <- placeholder $ cfg
60− { _placeholderConfig_insertAbove = ffor (_placeholderConfig_insertAbove cfg) $ \a -> runPostBuildT a =<< headE childPostBuild
61− }
62− return p
63− {-# INLINABLE inputElement #-}
64− inputElement cfg = lift $ inputElement $ cfg & inputElementConfig_elementConfig %~ liftPostBuildTElementConfig
65− {-# INLINABLE textAreaElement #-}
66− textAreaElement cfg = lift $ textAreaElement $ cfg & textAreaElementConfig_elementConfig %~ liftPostBuildTElementConfig
67− placeRawElement = lift . placeRawElement
68− wrapRawElement e cfg = liftWith $ \run -> wrapRawElement e $ fmap1 run cfg
69−
70−instance MonadSample t m => MonadSample t (PostBuildT t m) where
71− {-# INLINABLE sample #-}
72− sample = lift . sample
73−
74−instance MonadHold t m => MonadHold t (PostBuildT t m) where
75− {-# INLINABLE hold #-}
76− hold v0 = lift . hold v0
77− {-# INLINABLE holdDyn #-}
78− holdDyn v0 = lift . holdDyn v0
79− {-# INLINABLE holdIncremental #-}
80− holdIncremental v0 = lift . holdIncremental v0
81−
82−instance PerformEvent t m => PerformEvent t (PostBuildT t m) where
83− type Performable (PostBuildT t m) = PostBuildT t (Performable m)
84− {-# INLINABLE performEvent_ #-}
85− performEvent_ e = liftWith $ \run -> performEvent_ $ fmap run e
86− {-# INLINABLE performEvent #-}
87− performEvent e = liftWith $ \run -> performEvent $ fmap run e
88−
89−instance (ReflexHost t, MonadReflexCreateTrigger t m) => MonadReflexCreateTrigger t (PostBuildT t m) where
90− {-# INLINABLE newEventWithTrigger #-}
91− newEventWithTrigger = PostBuildT . lift . newEventWithTrigger
92− {-# INLINABLE newFanEventWithTrigger #-}
93− newFanEventWithTrigger f = PostBuildT $ lift $ newFanEventWithTrigger f
94−
95−instance TriggerEvent t m => TriggerEvent t (PostBuildT t m) where
96− {-# INLINABLE newTriggerEvent #-}
97− newTriggerEvent = lift newTriggerEvent
98− {-# INLINABLE newTriggerEventWithOnComplete #-}
99− newTriggerEventWithOnComplete = lift newTriggerEventWithOnComplete
100− newEventWithLazyTriggerWithOnComplete = lift . newEventWithLazyTriggerWithOnComplete
101−
102−instance MonadRef m => MonadRef (PostBuildT t m) where
103− type Ref (PostBuildT t m) = Ref m
104− {-# INLINABLE newRef #-}
105− newRef = lift . newRef
106− {-# INLINABLE readRef #-}
107− readRef = lift . readRef
108− {-# INLINABLE writeRef #-}
109− writeRef r = lift . writeRef r
110−
111−instance MonadAtomicRef m => MonadAtomicRef (PostBuildT t m) where
112− {-# INLINABLE atomicModifyRef #-}
113− atomicModifyRef r = lift . atomicModifyRef r
114−
115−instance (HasJS x m, ReflexHost t) => HasJS x (PostBuildT t m) where
116− type JSM (PostBuildT t m) = JSM m
117− liftJS = lift . liftJS
118−
119−instance HasWebView m => HasWebView (PostBuildT t m) where
120− type WebViewPhantom (PostBuildT t m) = WebViewPhantom m
121− askWebView = lift askWebView
122−
123−{-# INLINABLE runPostBuildT #-}
124−runPostBuildT :: PostBuildT t m a -> Event t () -> m a
125−runPostBuildT (PostBuildT a) = runReaderT a
126−
127−instance PostBuild t m => PostBuild t (ReaderT r m) where
128− getPostBuild = lift getPostBuild