git.iko.soy/reflex-dom
on develop help sign in
Add Reflex.Dom.Location
commitb10dd40c43bb0bd0a8098d4c579acacd815b5503 authorAli Abrar <aliabrar@gmail.com> dateSat 28 Nov 2015, 22:55 (11 years ago) parent4a4e39d
6 files changed+41−27
compare with develop
unifiedsplit
reflex-dom.cabal+1 src-ghc/Reflex/Dom/Internal/Foreign.hs+17 src-ghc/Reflex/Dom/WebSocket/Foreign.hs−16 src-ghcjs/Reflex/Dom/Internal/Foreign.hs+21−1 src-ghcjs/Reflex/Dom/WebSocket/Foreign.hs−10 src/Reflex/Dom.hs+2
reflex-dom.cabal+1
@@ -67,6 +67,7 @@ library
6767 Reflex.Dom.Widget.Lazy
6868 Reflex.Dom.Widget.Resize
6969 Reflex.Dom.Xhr
70+ Reflex.Dom.Location
7071 other-modules:
7172 Reflex.Dom.Internal.Foreign
7273 Reflex.Dom.WebSocket.Foreign
src-ghc/Reflex/Dom/Internal/Foreign.hs+17
@@ -13,6 +13,7 @@ import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase
1313import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef
1414import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef
1515import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef
16+import Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame
1617import Graphics.UI.Gtk.WebKit.WebView
1718import Graphics.UI.Gtk.WebKit.Types hiding (Event, Widget, unWidget)
1819import Graphics.UI.Gtk.WebKit.WebSettings
@@ -99,3 +100,19 @@ fromJSStringMaybe c t = do
99100 peekCString ps
100101 return $ Just s
101102
103+getLocationHost :: WebView -> IO String
104+getLocationHost wv = do
105+ c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv
106+ script <- jsstringcreatewithutf8cstring "location.host"
107+ lh <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr
108+ lh' <- fromJSStringMaybe c lh
109+ return $ maybe "" id lh'
110+
111+getLocationProtocol :: WebView -> IO String
112+getLocationProtocol wv = do
113+ c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv
114+ script <- jsstringcreatewithutf8cstring "location.protocol"
115+ lp <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr
116+ lp' <- fromJSStringMaybe c lp
117+ return $ maybe "" id lp'
118+
src-ghc/Reflex/Dom/WebSocket/Foreign.hs−16
@@ -26,22 +26,6 @@ data JSWebSocket = JSWebSocket { wsValue :: JSValueRef
2626 , wsContext :: JSContextRef
2727 }
2828
29−getLocationHost :: WebView -> IO String
30−getLocationHost wv = do
31− c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv
32− script <- jsstringcreatewithutf8cstring "location.host"
33− lh <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr
34− lh' <- fromJSStringMaybe c lh
35− return $ maybe "" id lh'
36−
37−getLocationProtocol :: WebView -> IO String
38−getLocationProtocol wv = do
39− c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv
40− script <- jsstringcreatewithutf8cstring "location.protocol"
41− lp <- jsevaluatescript c script nullPtr nullPtr 1 nullPtr
42− lp' <- fromJSStringMaybe c lp
43− return $ maybe "" id lp'
44−
4529newWebSocket :: WebView -> String -> (ByteString -> IO ()) -> IO () -> IO JSWebSocket
4630newWebSocket wv url onMessage onClose = do
4731 c <- webFrameGetGlobalContext =<< webViewGetMainFrame wv
src-ghcjs/Reflex/Dom/Internal/Foreign.hs+21−1
@@ -1,9 +1,29 @@
1−module Reflex.Dom.Internal.Foreign (runWebGUI) where
1+{-# LANGUAGE ForeignFunctionInterface, JavaScriptFFI, CPP #-}
22
3+module Reflex.Dom.Internal.Foreign ( runWebGUI
4+ , module Reflex.Dom.Internal.Foreign
5+ ) where
6+
7+import Control.Monad
38import GHCJS.DOM
49import GHCJS.DOM.Types
510import GHCJS.Types
611import Data.Function
12+import GHCJS.Foreign
13+
14+#define JS(name, js, type) foreign import javascript unsafe js name :: type
715
816instance Eq Node where
917 (==) = eqRef `on` unNode
18+
19+JS(getLocationHost_, "location.host", IO JSString)
20+
21+getLocationHost :: FromJSString r => a -> IO r
22+getLocationHost _ = liftM fromJSString getLocationHost_
23+
24+JS(getLocationProtocol_, "location.protocol", IO JSString)
25+
26+getLocationProtocol :: FromJSString r => a -> IO r
27+getLocationProtocol _ = liftM fromJSString getLocationProtocol_
28+
29+
src-ghcjs/Reflex/Dom/WebSocket/Foreign.hs−10
@@ -28,16 +28,6 @@ webSocketSend ws bs = BS.useAsCString bs $ \cStr -> do
2828 ba <- extractByteArray cStr $ BS.length bs
2929 webSocketSend_ (unWebSocket ws) ba
3030
31−JS(getLocationHost_, "location.host", IO JSString)
32−
33−getLocationHost :: FromJSString r => a -> IO r
34−getLocationHost _ = liftM fromJSString getLocationHost_
35−
36−JS(getLocationProtocol_, "location.protocol", IO JSString)
37−
38−getLocationProtocol :: FromJSString r => a -> IO r
39−getLocationProtocol _ = liftM fromJSString getLocationProtocol_
40−
4131newWebSocket :: a -> String -> (ByteString -> IO ()) -> IO () -> IO JSWebSocket
4232newWebSocket _ url onMessage onClose = do
4333 onMessageFun <- syncCallback1 AlwaysRetain True $ onMessage <=< return . encodeUtf8 . fromJSString
src/Reflex/Dom.hs+2
@@ -5,6 +5,7 @@ module Reflex.Dom ( module Reflex
55 , module Reflex.Dom.Xhr
66 , module Reflex.Dom.Time
77 , module Reflex.Dom.WebSocket
8+ , module Reflex.Dom.Location
89 ) where
910
1011import Reflex
@@ -14,3 +15,4 @@ import Reflex.Dom.Widget
1415import Reflex.Dom.Xhr
1516import Reflex.Dom.Time
1617import Reflex.Dom.WebSocket
18+import Reflex.Dom.Location