23e45fe · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Move WebView-related stuff into Foreign.JavaScript.TH

commit23e45fef53d503f2cf8e2fcf95883c0fdbe04db3 authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 30 Nov 2015, 19:09 (11 years ago) parentf25d9ef

6 files changed+53−37

compare with develop

unifiedsplit

src/Foreign/JavaScript/TH.hs+33−1 src/Reflex/Dom/Class.hs+4−23 src/Reflex/Dom/DynamicWriter.hs+1 src/Reflex/Dom/Internal.hs+1−9 src/Reflex/Dom/Location.hs+10−1 src/Reflex/Dom/Xhr.hs+4−3

src/Foreign/JavaScript/TH.hs+33−1

@@ -12,6 +12,7 @@ import Language.Haskell.TH

1212import qualified GHCJS.Marshal as JS

1313import qualified GHCJS.Foreign as JS

1414import qualified GHCJS.Types as JS

15+import GHCJS.DOM

1516import GHCJS.DOM.Types

1617import Data.Word

1718import Foreign.Ptr

@@ -34,6 +35,8 @@ import Control.Monad.Fix

3435import Control.Monad.IO.Class

3536import Control.Monad.Exception

3637import Control.Monad.Reader

38+import Control.Monad.State

39+import qualified Control.Monad.State.Strict as Strict

3740import Foreign.Marshal

3841import Data.ByteString (ByteString)

3942import qualified Data.ByteString as BS

@@ -42,7 +45,36 @@ import Data.Coerce

4245import Text.Encoding.Z

4346import Data.Monoid

4447

45−import Reflex.Dom (WithWebView, askWebView, runWithWebView, unWebViewSingleton)

48+class Monad m => HasWebView m where

49+ type WebViewPhantom m :: *

50+ askWebView :: m (WebViewSingleton (WebViewPhantom m))

51+

52+instance HasWebView m => HasWebView (ReaderT r m) where

53+ type WebViewPhantom (ReaderT r m) = WebViewPhantom m

54+ askWebView = lift askWebView

55+

56+instance HasWebView m => HasWebView (StateT r m) where

57+ type WebViewPhantom (StateT r m) = WebViewPhantom m

58+ askWebView = lift askWebView

59+

60+instance HasWebView m => HasWebView (Strict.StateT r m) where

61+ type WebViewPhantom (Strict.StateT r m) = WebViewPhantom m

62+ askWebView = lift askWebView

63+

64+newtype WithWebView x m a = WithWebView { unWithWebView :: ReaderT (WebViewSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException)

65+

66+runWithWebView :: WithWebView x m a -> WebViewSingleton x -> m a

67+runWithWebView = runReaderT . unWithWebView

68+

69+instance (Monad m) => HasWebView (WithWebView x m) where

70+ type WebViewPhantom (WithWebView x m) = x

71+ askWebView = WithWebView ask

72+

73+withWebViewSingleton :: WebView -> (forall x. WebViewSingleton x -> r) -> r

74+withWebViewSingleton wv f = f $ WebViewSingleton wv

75+

76+-- | A singleton type for a given WebView; we use this to statically guarantee that different WebViews (and thus different javscript contexts) don't get mixed up

77+newtype WebViewSingleton x = WebViewSingleton { unWebViewSingleton :: WebView }

4678

4779#ifdef __GHCJS__

4880type JSFFI_Internal = JS.JSArray (JSRef JSCtx_IO) -> IO (JS.JSRef (JSRef JSCtx_IO))

src/Reflex/Dom/Class.hs+4−23

@@ -1,10 +1,13 @@

11{-# LANGUAGE TypeFamilies, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, RankNTypes, GADTs, ScopedTypeVariables, FunctionalDependencies, RecursiveDo, UndecidableInstances, GeneralizedNewtypeDeriving, StandaloneDeriving, EmptyDataDecls, NoMonomorphismRestriction, TemplateHaskell, PolyKinds, TypeOperators, DeriveFunctor, LambdaCase, CPP, ForeignFunctionInterface, DeriveDataTypeable, ConstraintKinds, DefaultSignatures #-}

2−module Reflex.Dom.Class where

2+module Reflex.Dom.Class ( module Reflex.Dom.Class

3+ , module Foreign.JavaScript.TH

4+ ) where

46import Prelude hiding (mapM, mapM_, sequence, concat)

68import Reflex

79import Reflex.Host.Class

10+import Foreign.JavaScript.TH

811

912import Control.Monad.Identity hiding (mapM, mapM_, forM, forM_, sequence)

1013import Data.Map (Map)

@@ -64,28 +67,6 @@ instance HasDocument m => HasDocument (StateT r m) where

6467instance HasDocument m => HasDocument (Strict.StateT r m) where

6568 askDocument = lift askDocument

6669

67−-- | A singleton type for a given WebView; we use this to statically guarantee that different WebViews (and thus different javscript contexts) don't get mixed up

68−newtype WebViewSingleton x = WebViewSingleton { unWebViewSingleton :: WebView }

69−

70−withWebViewSingleton :: WebView -> (forall x. WebViewSingleton x -> r) -> r

71−withWebViewSingleton wv f = f $ WebViewSingleton wv

72−

73−class Monad m => HasWebView m where

74− type WebViewPhantom m :: *

75− askWebView :: m (WebViewSingleton (WebViewPhantom m))

76−

77−instance HasWebView m => HasWebView (ReaderT r m) where

78− type WebViewPhantom (ReaderT r m) = WebViewPhantom m

79− askWebView = lift askWebView

80−

81−instance HasWebView m => HasWebView (StateT r m) where

82− type WebViewPhantom (StateT r m) = WebViewPhantom m

83− askWebView = lift askWebView

84−

85−instance HasWebView m => HasWebView (Strict.StateT r m) where

86− type WebViewPhantom (Strict.StateT r m) = WebViewPhantom m

87− askWebView = lift askWebView

88−

8970newtype Restore m = Restore { restore :: forall a. m a -> IO a }

9071

9172class Monad m => MonadIORestore m where

src/Reflex/Dom/DynamicWriter.hs+1

@@ -4,6 +4,7 @@ module Reflex.Dom.DynamicWriter where

44import Reflex

55import Reflex.Host.Class

66import Reflex.Dom.Class

78import Control.Monad.IO.Class

89import Control.Monad.State.Strict

910import Control.Monad.Ref

src/Reflex/Dom/Internal.hs+1−9

@@ -5,6 +5,7 @@ import Prelude hiding (mapM, mapM_, concat, sequence, sequence_)

66import Reflex.Dom.Internal.Foreign

77import Reflex.Dom.Class

8+import Foreign.JavaScript.TH

910import GHCJS.DOM hiding (runWebGUI)

1011import GHCJS.DOM.Types hiding (Widget, unWidget, Event)

@@ -210,12 +211,6 @@ mainWidgetWithCss css w = runWebGUI $ \webView -> withWebViewSingleton webView $

210211 Just body <- documentGetBody doc

211212 attachWidget body webViewSing w

212213

213−newtype WithWebView x m a = WithWebView { unWithWebView :: ReaderT (WebViewSingleton x) m a } deriving (Functor, Applicative, Monad, MonadIO, MonadFix, MonadException, MonadAsyncException)

214−

215−instance (Monad m) => HasWebView (WithWebView x m) where

216− type WebViewPhantom (WithWebView x m) = x

217− askWebView = WithWebView ask

218−

219214instance HasPostGui t h m => HasPostGui t (WithWebView x h) (WithWebView x m) where

220215 askPostGui = do

221216 postGui <- lift askPostGui

@@ -255,9 +250,6 @@ instance MonadReflexHost t m => MonadReflexHost t (WithWebView x m) where

255250 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

256251 runHostFrame = lift . runHostFrame

257252

258−runWithWebView :: WithWebView x m a -> WebViewSingleton x -> m a

259−runWithWebView = runReaderT . unWithWebView

260−

261253attachWidget :: forall e x a. (IsHTMLElement e) => e -> WebViewSingleton x -> Widget Spider (Gui Spider (WithWebView x SpiderHost) x (HostFrame Spider)) a -> IO a

262254attachWidget rootElement wv w = runSpiderHost $ flip runWithWebView wv $ do --TODO: It seems to re-run this handler if the URL changes, even if it's only the fragment

263255 Just doc <- liftM (fmap castToHTMLDocument) $ liftIO $ nodeGetOwnerDocument rootElement

src/Reflex/Dom/Location.hs+10−1

@@ -1,3 +1,12 @@

11module Reflex.Dom.Location (getLocationHost, getLocationProtocol) where

3−import Reflex.Dom.Internal.Foreign

3+import Reflex.Dom.Class

4+import qualified Reflex.Dom.Internal.Foreign as F

6+import Control.Monad.IO.Class

8+getLocationHost :: (MonadIO m) => WebViewSingleton x -> m String

9+getLocationHost (WebViewSingleton wv) = liftIO $ F.getLocationHost wv

10+

11+getLocationProtocol :: (MonadIO m) => WebViewSingleton x -> m String

12+getLocationProtocol (WebViewSingleton wv) = liftIO $ F.getLocationProtocol wv

src/Reflex/Dom/Xhr.hs+4−3

@@ -16,6 +16,10 @@ module Reflex.Dom.Xhr

1616 )

1717where

1818

19+import Reflex

20+import Reflex.Dom.Class

21+import Reflex.Dom.Xhr.Foreign

22+

1923import Control.Concurrent

2024import Control.Lens

2125import Control.Monad hiding (forM)

@@ -32,9 +36,6 @@ import Data.Maybe

3236import Data.Text (Text)

3337import Data.Text.Encoding

3438import Data.Traversable

35−import Reflex

36−import Reflex.Dom.Class

37−import Reflex.Dom.Xhr.Foreign

3839import Data.Typeable

3940

4041data XhrRequest a