git.iko.soy/reflex-dom
on develop help sign in
Add DomBuilder, HasJS, HasJSContext and DomRenderHook instances for QueryT
23389e9Luigy Leon
reflex-dom-core/src/Foreign/JavaScript/TH.hs+8
compare with develop
unifiedsplit
@@ -125,6 +125,10 @@ instance HasJSContext m => HasJSContext (RequesterT t request response m) where
125 type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m
125 type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m
126 askJSContext = lift askJSContext
126 askJSContext = lift askJSContext
127
127
128+instance HasJSContext m => HasJSContext (QueryT t q m) where
129+ type JSContextPhantom (QueryT t q m) = JSContextPhantom m
130+ askJSContext = QueryT askJSContext
131+
128newtype WithJSContextSingleton x m a = WithJSContextSingleton { unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
132newtype WithJSContextSingleton x m a = WithJSContextSingleton { unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
129
133
130instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where
134instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where
@@ -248,6 +252,10 @@ instance HasJS x m => HasJS x (RequesterT t request response m) where
248 type JSX (RequesterT t request response m) = JSX m
252 type JSX (RequesterT t request response m) = JSX m
249 liftJS = lift . liftJS
253 liftJS = lift . liftJS
250
254
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+
251-- | A Monad that is capable of executing JavaScript
259-- | A Monad that is capable of executing JavaScript
252class Monad m => MonadJS x m | m -> x where
260class Monad m => MonadJS x m | m -> x where
253 runJS :: JSFFI -> [JSRef x] -> m (JSRef x)
261 runJS :: JSFFI -> [JSRef x] -> m (JSRef x)
reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+28
@@ -34,6 +34,8 @@ import Reflex.DynamicWriter
34import Reflex.EventWriter
34import Reflex.EventWriter
35import Reflex.PerformEvent.Class
35import Reflex.PerformEvent.Class
36import Reflex.PostBuild.Base
36import Reflex.PostBuild.Base
37+import Reflex.Query.Base
38+import Reflex.Query.Class
37import Reflex.Requester.Base
39import Reflex.Requester.Base
38
40
39import qualified Control.Category
41import qualified Control.Category
@@ -574,6 +576,31 @@ instance (DomBuilder t m, MonadHold t m, MonadFix m, Semigroup w, Monoid w) => D
574 placeRawElement = lift . placeRawElement
576 placeRawElement = lift . placeRawElement
575 wrapRawElement e = lift . wrapRawElement e
577 wrapRawElement e = lift . wrapRawElement e
576
578
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+
577-- * Convenience functions
604-- * Convenience functions
578
605
579class HasDomEvent t target eventName where
606class HasDomEvent t target eventName where
@@ -650,6 +677,7 @@ deriving instance DomRenderHook t m => DomRenderHook t (EventWriterT t w m)
650deriving instance DomRenderHook t m => DomRenderHook t (RequesterT t req rsp m)
677deriving instance DomRenderHook t m => DomRenderHook t (RequesterT t req rsp m)
651#endif
678#endif
652deriving instance DomRenderHook t m => DomRenderHook t (PostBuildT t m)
679deriving instance DomRenderHook t m => DomRenderHook t (PostBuildT t m)
680+deriving instance DomRenderHook t m => DomRenderHook t (QueryT t m)
653
681
654{-# DEPRECATED liftElementConfig "Use 'id' instead; this function is no longer necessary" #-}
682{-# DEPRECATED liftElementConfig "Use 'id' instead; this function is no longer necessary" #-}
655liftElementConfig :: ElementConfig er t s -> ElementConfig er t s
683liftElementConfig :: ElementConfig er t s -> ElementConfig er t s