git.iko.soy/reflex-dom
on develop help sign in
Merge remote-tracking branch 'origin/os-query' into develop
3eef4dfRyan Trinkle
reflex-dom-core/src/Foreign/JavaScript/TH.hs+9
compare with develop
unifiedsplit
@@ -34,6 +34,7 @@ import Reflex.Host.Class
34import Reflex.PerformEvent.Base
34import Reflex.PerformEvent.Base
35import Reflex.PerformEvent.Class
35import Reflex.PerformEvent.Class
36import Reflex.PostBuild.Base
36import Reflex.PostBuild.Base
37+import Reflex.Query.Base
37import Reflex.Requester.Base
38import Reflex.Requester.Base
38
39
39#ifdef USE_TEMPLATE_HASKELL
40#ifdef USE_TEMPLATE_HASKELL
@@ -125,6 +126,10 @@ instance HasJSContext m => HasJSContext (RequesterT t request response m) where
125 type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m
126 type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m
126 askJSContext = lift askJSContext
127 askJSContext = lift askJSContext
127
128
129+instance HasJSContext m => HasJSContext (QueryT t q m) where
130+ type JSContextPhantom (QueryT t q m) = JSContextPhantom m
131+ askJSContext = QueryT askJSContext
132+
128newtype WithJSContextSingleton x m a = WithJSContextSingleton { unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
133newtype WithJSContextSingleton x m a = WithJSContextSingleton { unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
129
134
130instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where
135instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where
@@ -248,6 +253,10 @@ instance HasJS x m => HasJS x (RequesterT t request response m) where
248 type JSX (RequesterT t request response m) = JSX m
253 type JSX (RequesterT t request response m) = JSX m
249 liftJS = lift . liftJS
254 liftJS = lift . liftJS
250
255
256+instance HasJS x m => HasJS x (QueryT t q m) where
257+ type JSX (QueryT t q m) = JSX m
258+ liftJS = lift . liftJS
259+
251-- | A Monad that is capable of executing JavaScript
260-- | A Monad that is capable of executing JavaScript
252class Monad m => MonadJS x m | m -> x where
261class Monad m => MonadJS x m | m -> x where
253 runJS :: JSFFI -> [JSRef x] -> m (JSRef x)
262 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 q 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