on develop help sign in
Add MonadJS to HasJS & MonadJS orphan instances
commit5793a2f4501afcb107d5e3cccdd7008a6e42573c authorHamish Mackenzie <Hamish.K.Mackenzie@googlemail.com> dateTue 7 Feb 2017, 15:59 (10 years ago) parent385cc3a
5 files changed+33−6
reflex-dom-core/reflex-dom-core.cabal+1 reflex-dom-core/src/Foreign/JavaScript/Orphans.hs+28 reflex-dom-core/src/Foreign/JavaScript/TH.hs+3−1 reflex-dom-core/src/Reflex/Dom/Main.hs−5 reflex-dom/reflex-dom.cabal+1
reflex-dom-core/reflex-dom-core.cabal+1
@@ -76,6 +76,7 @@ library
7676
7777 exposed-modules:
7878 Foreign.JavaScript.TH
79+ Foreign.JavaScript.Orphans
7980 Reflex.Dom.Builder.Class
8081 Reflex.Dom.Builder.Class.Events
8182 Reflex.Dom.Builder.Immediate
reflex-dom-core/src/Foreign/JavaScript/Orphans.hsnew file+28
@@ -0,0 +1,28 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE FlexibleContexts #-}
3+{-# OPTIONS_GHC -fno-warn-orphan-instances #-}
4+module Foreign.JavaScript.Orphans where
5+
6+#ifndef __GHCJS__
7+
8+import Reflex.Host.Class (ReflexHost, HostFrame)
9+import Control.Monad.Trans.Class (lift)
10+import Reflex.PostBuild.Base (PostBuildT)
11+import Reflex.PerformEvent.Base (PerformEventT(..))
12+import Reflex.DynamicWriter (DynamicWriterT)
13+import Reflex.Requester.Base (RequesterT)
14+import GHCJS.DOM.Types (MonadJSM(..))
15+
16+instance (MonadJSM m, ReflexHost t) => MonadJSM (PostBuildT t m) where
17+ liftJSM' = lift . liftJSM'
18+
19+instance (MonadJSM (HostFrame t), ReflexHost t) => MonadJSM (PerformEventT t m) where
20+ liftJSM' = PerformEventT . lift . liftJSM'
21+
22+instance MonadJSM m => MonadJSM (DynamicWriterT t w m) where
23+ liftJSM' = lift . liftJSM'
24+
25+instance MonadJSM m => MonadJSM (RequesterT t request response m) where
26+ liftJSM' = lift . liftJSM'
27+
28+#endif
reflex-dom-core/src/Foreign/JavaScript/TH.hs+3−1
@@ -20,6 +20,7 @@
2020{-# LANGUAGE JavaScriptFFI #-}
2121#endif
2222module Foreign.JavaScript.TH ( module Foreign.JavaScript.TH
23+ , module Foreign.JavaScript.Orphans
2324#ifdef USE_TEMPLATE_HASKELL
2425 , Safety (..)
2526#endif
@@ -34,6 +35,7 @@ import Reflex.PerformEvent.Base
3435import Reflex.PerformEvent.Class
3536import Reflex.PostBuild.Base
3637import Reflex.Requester.Base
38+import Foreign.JavaScript.Orphans
3739
3840#ifdef USE_TEMPLATE_HASKELL
3941import Language.Haskell.TH
@@ -227,7 +229,7 @@ instance ToJS x (JSFun x) where
227229class IsJSContext x where
228230 data JSRef x
229231
230−class (Monad m, MonadIO (JSX m), MonadFix (JSX m), MonadJS x (JSX m)) => HasJS x m | m -> x where
232+class (Monad m, MonadJSM (JSX m), MonadFix (JSX m), MonadJS x (JSX m)) => HasJS x m | m -> x where
231233 type JSX m :: * -> *
232234 liftJS :: JSX m a -> m a
233235
reflex-dom-core/src/Reflex/Dom/Main.hs−5
@@ -82,11 +82,6 @@ mainWidgetWithCss css w = withJSContextSingleton $ \jsSing -> do
8282
8383type Widget x = PostBuildT Spider (ImmediateDomBuilderT Spider (WithJSContextSingleton x (PerformEventT Spider (SpiderHost Global)))) --TODO: Make this more abstract --TODO: Put the WithJSContext underneath PerformEventT - I think this would perform better
8484
85−#ifndef __GHCJS__
86−instance MonadJSM m => MonadJSM (PostBuildT t m) where
87− liftJSM' = PostBuildT . liftJSM'
88−#endif
89−
9085{-# INLINABLE attachWidget #-}
9186attachWidget :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM a
9287attachWidget rootElement wv w = fst <$> attachWidget' rootElement wv w
reflex-dom/reflex-dom.cabal+1
@@ -45,6 +45,7 @@ library
4545 Reflex.Dom.Internal
4646 reexported-modules:
4747 Foreign.JavaScript.TH
48+ , Foreign.JavaScript.Orphans
4849 , Reflex.Dom.Builder.Class
4950 , Reflex.Dom.Builder.Class.Events
5051 , Reflex.Dom.Builder.Immediate