git.iko.soy/reflex-dom
on develop help sign in
Add DomBuilder, HasJS, HasJSContext and DomRenderHook instances for QueryT
commit23389e90d30ada6e538f89d088fa3ca43ae65232 authorLuigy Leon <luigy@outlook.com> dateTue 2 May 2017, 17:58 (9 years ago) parent644b1a0
2 files changed+36
compare with develop
unifiedsplit
reflex-dom-core/src/Foreign/JavaScript/TH.hs+8 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+28
reflex-dom-core/src/Foreign/JavaScript/TH.hs+8
@@ -125,6 +125,10 @@ instance HasJSContext m => HasJSContext (RequesterT t request response m) where
125125 type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m
126126 askJSContext = lift askJSContext
127127
128+instance HasJSContext m => HasJSContext (QueryT t q m) where
129+ type JSContextPhantom (QueryT t q m) = JSContextPhantom m
130+ askJSContext = QueryT askJSContext
131+
128132newtype WithJSContextSingleton x m a = WithJSContextSingleton { unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
129133
130134instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where
@@ -248,6 +252,10 @@ instance HasJS x m => HasJS x (RequesterT t request response m) where
248252 type JSX (RequesterT t request response m) = JSX m
249253 liftJS = lift . liftJS
250254
255+instance HasJS x m => HasJS x (QueryT t q m) where
256+ type JSX (QueryT t q m) = JSX m
257+ liftJS = lift . liftJS
258+
251259-- | A Monad that is capable of executing JavaScript
252260class Monad m => MonadJS x m | m -> x where
253261 runJS :: JSFFI -> [JSRef x] -> m (JSRef x)
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+28
@@ -34,6 +34,8 @@ import Reflex.DynamicWriter
3434import Reflex.EventWriter
3535import Reflex.PerformEvent.Class
3636import Reflex.PostBuild.Base
37+import Reflex.Query.Base
38+import Reflex.Query.Class
3739import Reflex.Requester.Base
3840
3941import qualified Control.Category
@@ -574,6 +576,31 @@ instance (DomBuilder t m, MonadHold t m, MonadFix m, Semigroup w, Monoid w) => D
574576 placeRawElement = lift . placeRawElement
575577 wrapRawElement e = lift . wrapRawElement e
576578
579+instance (DomBuilder t m, MonadFix m, MonadHold t m, Group q, Query q, Additive q) => DomBuilder t (QueryT t q m) where
580+ type DomBuilderSpace (QueryT t q m) = DomBuilderSpace m
581+ textNode = liftTextNode
582+ element elementTag cfg (QueryT child) = QueryT $ do
583+ s <- get
584+ let cfg' = cfg
585+ { _elementConfig_eventSpec = _elementConfig_eventSpec cfg }
586+ (e, (a, newS)) <- lift $ element elementTag cfg' $ runStateT child s
587+ put newS
588+ return (e, a)
589+
590+ inputElement cfg = lift $ inputElement $ cfg & inputElementConfig_elementConfig %~ liftElementConfig
591+ textAreaElement cfg = lift $ textAreaElement $ cfg & textAreaElementConfig_elementConfig %~ liftElementConfig
592+ selectElement cfg (QueryT child) = QueryT $ do
593+ s <- get
594+ let cfg' = cfg & selectElementConfig_elementConfig %~ \c ->
595+ c { _elementConfig_eventSpec = _elementConfig_eventSpec c }
596+ (e, (a, newS)) <- lift $ selectElement cfg' $ runStateT child s
597+ put newS
598+ return (e, a)
599+ placeRawElement = lift . placeRawElement
600+ wrapRawElement e cfg = lift $ wrapRawElement e $ cfg
601+ { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg
602+ }
603+
577604-- * Convenience functions
578605
579606class HasDomEvent t target eventName where
@@ -650,6 +677,7 @@ deriving instance DomRenderHook t m => DomRenderHook t (EventWriterT t w m)
650677deriving instance DomRenderHook t m => DomRenderHook t (RequesterT t req rsp m)
651678#endif
652679deriving instance DomRenderHook t m => DomRenderHook t (PostBuildT t m)
680+deriving instance DomRenderHook t m => DomRenderHook t (QueryT t m)
653681
654682{-# DEPRECATED liftElementConfig "Use 'id' instead; this function is no longer necessary" #-}
655683liftElementConfig :: ElementConfig er t s -> ElementConfig er t s