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

git.iko.soy/reflex-dom

on develop help sign in

Move WebView-related stuff into Foreign.JavaScript.TH

23e45feRyan Trinkle11 years ago

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

compare with develop

unifiedsplit

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

12import qualified GHCJS.Marshal as JS

13import qualified GHCJS.Foreign as JS

14import qualified GHCJS.Types as JS

15+import GHCJS.DOM

15import GHCJS.DOM.Types

16import GHCJS.DOM.Types

16import Data.Word

17import Data.Word

17import Foreign.Ptr

18import Foreign.Ptr

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

34import Control.Monad.IO.Class

35import Control.Monad.IO.Class

35import Control.Monad.Exception

36import Control.Monad.Exception

36import Control.Monad.Reader

37import Control.Monad.Reader

38+import Control.Monad.State

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

37import Foreign.Marshal

40import Foreign.Marshal

38import Data.ByteString (ByteString)

41import Data.ByteString (ByteString)

39import qualified Data.ByteString as BS

42import qualified Data.ByteString as BS

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

42import Text.Encoding.Z

45import Text.Encoding.Z

43import Data.Monoid

46import Data.Monoid

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 }

47#ifdef __GHCJS__

79#ifdef __GHCJS__

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

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

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

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

1{-# 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

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

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

6import Reflex

8import Reflex

7import Reflex.Host.Class

9import Reflex.Host.Class

10+import Foreign.JavaScript.TH

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

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

10import Data.Map (Map)

13import Data.Map (Map)

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

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

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

65 askDocument = lift askDocument

68 askDocument = lift askDocument

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−

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

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

91class Monad m => MonadIORestore m where

72class Monad m => MonadIORestore m where

src/Reflex/Dom/DynamicWriter.hs+1

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

4import Reflex

5import Reflex.Host.Class

6import Reflex.Dom.Class

7import Control.Monad.IO.Class

8import Control.Monad.IO.Class

8import Control.Monad.State.Strict

9import Control.Monad.State.Strict

9import Control.Monad.Ref

10import Control.Monad.Ref

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

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

6import Reflex.Dom.Internal.Foreign

7import Reflex.Dom.Class

8+import Foreign.JavaScript.TH

9import GHCJS.DOM hiding (runWebGUI)

10import GHCJS.DOM hiding (runWebGUI)

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

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

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

210 Just body <- documentGetBody doc

211 Just body <- documentGetBody doc

211 attachWidget body webViewSing w

212 attachWidget body webViewSing w

212

213

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−

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

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

220 askPostGui = do

215 askPostGui = do

221 postGui <- lift askPostGui

216 postGui <- lift askPostGui

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

255 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

250 fireEventsAndRead dm a = lift $ fireEventsAndRead dm a

256 runHostFrame = lift . runHostFrame

251 runHostFrame = lift . runHostFrame

257

252

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

259−runWithWebView = runReaderT . unWithWebView

260−

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

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

262attachWidget 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

254attachWidget 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

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

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

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

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

1module 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

16 )

17where

19+import Reflex

20+import Reflex.Dom.Class

21+import Reflex.Dom.Xhr.Foreign

22+

19import Control.Concurrent

23import Control.Concurrent

20import Control.Lens

24import Control.Lens

21import Control.Monad hiding (forM)

25import Control.Monad hiding (forM)

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

32import Data.Text (Text)

36import Data.Text (Text)

33import Data.Text.Encoding

37import Data.Text.Encoding

34import Data.Traversable

38import Data.Traversable

35−import Reflex

36−import Reflex.Dom.Class

37−import Reflex.Dom.Xhr.Foreign

38import Data.Typeable

39import Data.Typeable

40data XhrRequest a

41data XhrRequest a