on develop help sign in
Merge remote-tracking branch 'origin/develop' into fix-dyn-pattern-match

# Conflicts: # reflex-dom.cabal # src/Reflex/Dom.hs

commite97f312bd8dc847d502b9d499670d864364c767a authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 30 Nov 2015, 14:19 (11 years ago) parent10f08e771f1e6c
9 files changed+49−28
README.md+4 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 src/Reflex/Dom/Location.hs+3 src/Reflex/Dom/Widget/Basic.hs+1−1
README.md+4
@@ -5,9 +5,13 @@ Reflex-DOM is a framework for building web applications in Haskell, based on the
55
66Comprehensive documentation is still a work in progress, but a [demo](https://github.com/ryantrinkle/try-reflex) is available and an introductory talk is available at [Part 1](https://www.youtube.com/watch?v=mYvkcskJbc4) / [Part 2](https://www.youtube.com/watch?v=3qfc9XFVo2c) ([Slides](https://obsidian.systems/reflex-nyhug/)).
77
8+A summary of Reflex-DOM functions is available in the [quick reference](Quickref.md).
9+
810### Additional resources
911[try reflex](https://github.com/ryantrinkle/try-reflex)
1012
1113[reddit/r/reflexfrp](http://www.reddit.com/r/reflexfrp)
1214
15+[reflex-examples](https://github.com/reflex-frp/reflex-examples)
16+
1317irc.freenode.net #reflex-frp
reflex-dom.cabal+1
@@ -74,6 +74,7 @@ library
7474 Reflex.Dom.Widget.Lazy
7575 Reflex.Dom.Widget.Resize
7676 Reflex.Dom.Xhr
77+ Reflex.Dom.Location
7778 Foreign.JavaScript.TH
7879 other-modules:
7980 Reflex.Dom.Internal.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
@@ -6,6 +6,7 @@ module Reflex.Dom ( module Reflex
66 , module Reflex.Dom.Time
77 , module Reflex.Dom.WebSocket
88 , module Reflex.Dom.DynamicWriter
9+ , module Reflex.Dom.Location
910 ) where
1011
1112import Reflex
@@ -16,3 +17,4 @@ import Reflex.Dom.Xhr
1617import Reflex.Dom.Time
1718import Reflex.Dom.WebSocket
1819import Reflex.Dom.DynamicWriter
20+import Reflex.Dom.Location
src/Reflex/Dom/Location.hsnew file+3
@@ -0,0 +1,3 @@
1+module Reflex.Dom.Location (getLocationHost, getLocationProtocol) where
2+
3+import Reflex.Dom.Internal.Foreign
src/Reflex/Dom/Widget/Basic.hs+1−1
@@ -795,7 +795,7 @@ link s = linkClass s ""
795795
796796button :: MonadWidget t m => String -> m (Event t ())
797797button s = do
798− (e, _) <- el' "button" $ text s
798+ (e, _) <- elAttr' "button" (Map.singleton "type" "button") $ text s
799799 return $ domEvent Click e
800800
801801newtype Workflow t m a = Workflow { unWorkflow :: m (a, Event t (Workflow t m a)) }