git.iko.soy/reflex-dom
on develop help sign in
Merge remote-tracking branch 'origin/os-query' into develop
commit3eef4df70eb656fc33d6147633b625342198b811 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 22 May 2017, 16:47 (9 years ago) parent706ab4734c90c9
2 files changed+37
compare with develop
unifiedsplit
reflex-dom-core/src/Foreign/JavaScript/TH.hs+9 reflex-dom-core/src/Reflex/Dom/Builder/Class.hs+28
reflex-dom-core/src/Foreign/JavaScript/TH.hs+9
@@ -34,6 +34,7 @@ import Reflex.Host.Class
3434import Reflex.PerformEvent.Base
3535import Reflex.PerformEvent.Class
3636import Reflex.PostBuild.Base
37+import Reflex.Query.Base
3738import Reflex.Requester.Base
3839
3940#ifdef USE_TEMPLATE_HASKELL
@@ -125,6 +126,10 @@ instance HasJSContext m => HasJSContext (RequesterT t request response m) where
125126 type JSContextPhantom (RequesterT t request response m) = JSContextPhantom m
126127 askJSContext = lift askJSContext
127128
129+instance HasJSContext m => HasJSContext (QueryT t q m) where
130+ type JSContextPhantom (QueryT t q m) = JSContextPhantom m
131+ askJSContext = QueryT askJSContext
132+
128133newtype WithJSContextSingleton x m a = WithJSContextSingleton { unWithJSContextSingleton :: ReaderT (JSContextSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
129134
130135instance PrimMonad m => PrimMonad (WithJSContextSingleton x m) where
@@ -248,6 +253,10 @@ instance HasJS x m => HasJS x (RequesterT t request response m) where
248253 type JSX (RequesterT t request response m) = JSX m
249254 liftJS = lift . liftJS
250255
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+
251260-- | A Monad that is capable of executing JavaScript
252261class Monad m => MonadJS x m | m -> x where
253262 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 q m)
653681
654682{-# DEPRECATED liftElementConfig "Use 'id' instead; this function is no longer necessary" #-}
655683liftElementConfig :: ElementConfig er t s -> ElementConfig er t s