on develop help sign in
Add some instances and functions
commit0594fe4eabc84a9ee48f0cc0fa492f959a891d64 authorRyan Trinkle <ryan.trinkle@gmail.com> dateFri 30 Sep 2016, 12:48 (10 years ago) parentec7373e
4 files changed+68−24
reflex-dom.cabal+25−24 src/Foreign/JavaScript/TH.hs+13 src/Reflex/Dom/Builder/Class.hs+25 src/Reflex/Dom/Builder/Immediate.hs+5
reflex-dom.cabal+25−24
@@ -23,36 +23,37 @@ extra-source-files: src-ghc/Reflex/Dom/Internal/Foreign.hs
2323library
2424 hs-source-dirs: src
2525 build-depends:
26+ aeson >= 0.8 && < 0.12,
2627 base >= 4.7 && < 4.10,
27− template-haskell,
28− stm == 2.4.*,
29− reflex == 0.5.*,
30− dependent-sum == 0.3.*,
31− dependent-map == 0.2.*,
32− semigroups >= 0.16 && < 0.19,
33− mtl >= 2.1 && < 2.3,
34− containers == 0.5.*,
35− these >= 0.4 && < 0.8,
36− ref-tf == 0.4.*,
37− random == 1.1.*,
38− ghcjs-dom >= 0.2.1 && < 0.3,
39− transformers >= 0.3 && < 0.6,
40− lens >= 4.7 && < 5,
41− text == 1.2.*,
28+ bifunctors >= 4.2 && < 6,
29+ bimap >= 0.3 && < 0.4,
4230 blaze-builder,
4331 bytestring == 0.10.*,
32+ containers == 0.5.*,
4433 data-default >= 0.5 && < 0.8,
45− aeson >= 0.8 && < 0.12,
46− time >= 1.4 && < 1.7,
47− exception-transformers == 0.4.*,
48− directory == 1.2.*,
34+ dependent-map == 0.2.*,
35+ dependent-sum == 0.3.*,
4936 dependent-sum-template >= 0.0.0.4 && < 0.1,
50− zenc == 0.1.*,
51− bifunctors >= 4.2 && < 6,
52− bimap >= 0.3 && < 0.4,
53− monad-control >= 1.0.1 && < 1.1,
37+ directory == 1.2.*,
38+ exception-transformers == 0.4.*,
39+ ghcjs-dom >= 0.2.1 && < 0.3,
5440 keycode == 0.2.*,
55− unbounded-delays >= 0.1.0.9 && < 0.2
41+ lens >= 4.7 && < 5,
42+ monad-control >= 1.0.1 && < 1.1,
43+ mtl >= 2.1 && < 2.3,
44+ primitive >= 0.5 && < 0.7,
45+ random == 1.1.*,
46+ ref-tf == 0.4.*,
47+ reflex == 0.5.*,
48+ semigroups >= 0.16 && < 0.19,
49+ stm == 2.4.*,
50+ template-haskell,
51+ text == 1.2.*,
52+ these >= 0.4 && < 0.8,
53+ time >= 1.4 && < 1.7,
54+ transformers >= 0.3 && < 0.6,
55+ unbounded-delays >= 0.1.0.9 && < 0.2,
56+ zenc == 0.1.*
5657
5758 if impl(ghcjs)
5859 hs-source-dirs: src-ghcjs
src/Foreign/JavaScript/TH.hs+13
@@ -68,6 +68,7 @@ import Control.Monad
6868import Control.Monad.Exception
6969import Control.Monad.Fix
7070import Control.Monad.IO.Class
71+import Control.Monad.Primitive
7172import Control.Monad.Reader
7273import Control.Monad.Ref
7374import Control.Monad.State
@@ -110,8 +111,16 @@ instance HasWebView m => HasWebView (DynamicWriterT t w m) where
110111 type WebViewPhantom (DynamicWriterT t w m) = WebViewPhantom m
111112 askWebView = lift askWebView
112113
114+instance HasWebView m => HasWebView (RequestT t request response m) where
115+ type WebViewPhantom (RequestT t request response m) = WebViewPhantom m
116+ askWebView = lift askWebView
117+
113118newtype WithWebView x m a = WithWebView { unWithWebView :: ReaderT (WebViewSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadTrans, MonadException, MonadAsyncException)
114119
120+instance PrimMonad m => PrimMonad (WithWebView x m) where
121+ type PrimState (WithWebView x m) = PrimState m
122+ primitive = lift . primitive
123+
115124instance MonadAdjust t m => MonadAdjust t (WithWebView x m) where
116125 sequenceDMapWithAdjust dm0 dm' = WithWebView $ sequenceDMapWithAdjust (coerce dm0) (unsafeCoerce dm')
117126
@@ -218,6 +227,10 @@ instance HasJS x m => HasJS x (DynamicWriterT t w m) where
218227 type JSM (DynamicWriterT t w m) = JSM m
219228 liftJS = lift . liftJS
220229
230+instance HasJS x m => HasJS x (RequestT t request response m) where
231+ type JSM (RequestT t request response m) = JSM m
232+ liftJS = lift . liftJS
233+
221234-- | A Monad that is capable of executing JavaScript
222235class Monad m => MonadJS x m | m -> x where
223236 runJS :: JSFFI -> [JSRef x] -> m (JSRef x)
src/Reflex/Dom/Builder/Class.hs+25
@@ -24,6 +24,7 @@ import Reflex.Class as Reflex
2424import Reflex.Dom.Builder.Class.Events
2525import Reflex.DynamicWriter
2626import Reflex.PerformEvent.Class
27+import Reflex.PerformEvent.Base
2728import Reflex.PostBuild.Class
2829
2930import qualified Control.Category
@@ -424,6 +425,30 @@ instance (DomBuilder t m, Monoid w, MonadHold t m, MonadFix m) => DomBuilder t (
424425 { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg
425426 }
426427
428+instance (DomBuilder t m, MonadHold t m, MonadFix m) => DomBuilder t (RequestT t request response m) where
429+ type DomBuilderSpace (RequestT t request response m) = DomBuilderSpace m
430+ textNode = liftTextNode
431+ element elementTag cfg (RequestT child) = RequestT $ do
432+ r <- ask
433+ s <- get
434+ let cfg' = liftElementConfig cfg
435+ (el, (a, newS)) <- lift $ lift $ element elementTag cfg' $ runReaderT (runStateT child s) r
436+ put newS
437+ return (el, a)
438+ inputElement cfg = lift $ inputElement $ cfg & inputElementConfig_elementConfig %~ liftElementConfig
439+ textAreaElement cfg = lift $ textAreaElement $ cfg & textAreaElementConfig_elementConfig %~ liftElementConfig
440+ selectElement cfg (RequestT child) = RequestT $ do
441+ r <- ask
442+ s <- get
443+ let cfg' = cfg & selectElementConfig_elementConfig %~ liftElementConfig
444+ (el, (a, newS)) <- lift $ lift $ selectElement cfg' $ runReaderT (runStateT child s) r
445+ put newS
446+ return (el, a)
447+ placeRawElement = lift . placeRawElement
448+ wrapRawElement e cfg = lift $ wrapRawElement e $ cfg
449+ { _rawElementConfig_eventSpec = _rawElementConfig_eventSpec cfg
450+ }
451+
427452
428453-- * Convenience functions
429454
src/Reflex/Dom/Builder/Immediate.hs+5
@@ -28,6 +28,7 @@ import Reflex.Host.Class
2828import Control.Concurrent.Chan
2929import Control.Lens hiding (element)
3030import Control.Monad.Exception
31+import Control.Monad.Primitive
3132import Control.Monad.Reader
3233import Control.Monad.Ref
3334import Control.Monad.Trans.Control
@@ -81,6 +82,10 @@ data ImmediateDomBuilderEnv t
8182
8283newtype ImmediateDomBuilderT t m a = ImmediateDomBuilderT { unImmediateDomBuilderT :: ReaderT (ImmediateDomBuilderEnv t) m a } deriving (Functor, Applicative, Monad, MonadFix, MonadIO, MonadException, MonadAsyncException)
8384
85+instance PrimMonad m => PrimMonad (ImmediateDomBuilderT x m) where
86+ type PrimState (ImmediateDomBuilderT x m) = PrimState m
87+ primitive = lift . primitive
88+
8489instance MonadTransControl (ImmediateDomBuilderT t) where
8590 type StT (ImmediateDomBuilderT t) a = StT (ReaderT (ImmediateDomBuilderEnv t)) a
8691 liftWith = defaultLiftWith ImmediateDomBuilderT unImmediateDomBuilderT