ghcjs-dom-hello 4.0.0.0 → 5.0.0.0

raw patch · 6 files changed

+175/−46 lines, 6 filesdep +jsaddle-warpdep +jsaddle-webkit2gtkdep +jsaddle-webkitgtkdep ~basedep ~ghcjs-domdep ~mtlnew-component:exe:ghcjs-dom-hello-warpnew-component:exe:ghcjs-dom-hello-webkitgtknew-component:exe:ghcjs-dom-hello-wkwebview

Dependencies added: jsaddle-warp, jsaddle-webkit2gtk, jsaddle-webkitgtk, jsaddle-wkwebview

Dependency ranges changed: base, ghcjs-dom, mtl

Files

• ghcjs-dom-hello.cabal +87/−5
• src/HelloMain.hs +45/−0
• src/Main.hs +12/−41
• src/WKWebView.hs +9/−0
• src/Warp.hs +13/−0
• src/WebKitGTK.hs +9/−0

@@ -1,6 +1,6 @@ name: ghcjs-dom-hello-version: 4.0.0.0-cabal-version: >=1.6+version: 5.0.0.0+cabal-version: 1.24 build-type: Simple license: MIT license-file: LICENSE@@ -21,11 +21,93 @@     type: git     location: https://github.com/ghcjs/ghcjs-dom-hello +flag warp+    description: Build ghcjs-dom-hellp-warp+    default: True++flag webkitgtk+    description: Build ghcjs-dom-hellp-webkitgtk+    default: True++flag webkit2gtk+    description: Use WebKit2 version of WebKitGTK.+    default: True++library+    exposed-modules:+        HelloMain+    build-depends:+        base >=4.2 && <5,+        ghcjs-dom >=0.8 && <0.9,+        mtl >=2.1 && <2.3+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -Wall -ferror-spans+ executable ghcjs-dom-hello     main-is: Main.hs     build-depends:-        mtl >=2.1 && <2.3,-        base >=4.2 && <5,-        ghcjs-dom >=0.5 && <0.6+        base,+        ghcjs-dom,+        mtl     hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -threaded -Wall -ferror-spans++    -- Choose suitable runner+    if !impl(ghcjs)+      if os(osx) || os(ios)+        build-depends:+          jsaddle-wkwebview >=0.8 && <0.9+      else+        if flag(webkit2gtk)+          build-depends:+            jsaddle-webkit2gtk >=0.8 && <0.9+        else+          build-depends:+            jsaddle-webkitgtk >=0.8 && <0.9++executable ghcjs-dom-hello-warp+    if !flag(warp) || impl(ghcjs) || os(ios)+        buildable: False+    main-is: Warp.hs+    build-depends:+        base,+        ghcjs-dom,+        jsaddle-warp >=0.8 && <0.9,+        mtl+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -threaded -Wall -ferror-spans++executable ghcjs-dom-hello-webkitgtk+    if !flag(webkitgtk) || impl(ghcjs) || os(ios)+        buildable: False+    main-is: WebKitGTK.hs+    build-depends:+        base,+        ghcjs-dom,+        mtl+    if flag(webkit2gtk)+      build-depends:+        jsaddle-webkit2gtk >=0.8 && <0.9+    else+      build-depends:+        jsaddle-webkitgtk >=0.8 && <0.9+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -threaded -Wall -ferror-spans++executable ghcjs-dom-hello-wkwebview+    if !os(osx) || impl(ghcjs)+        buildable: False+    main-is: WKWebView.hs+    build-depends:+        base,+        ghcjs-dom,+        jsaddle-wkwebview >=0.8 && <0.9,+        mtl+    hs-source-dirs: src+    default-language: Haskell2010+    ghc-options: -threaded -Wall -ferror-spans 

@@ -0,0 +1,45 @@+module HelloMain (+    helloMain+) where++import Control.Monad.IO.Class (MonadIO(..))+import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar)++import GHCJS.DOM (syncPoint, currentDocument)+import GHCJS.DOM.Types+       (Element(..), HTMLParagraphElement(..), HTMLSpanElement(..), uncheckedCastTo, JSM)+import GHCJS.DOM.Document (getBodyUnsafe, createElement, createTextNode)+import GHCJS.DOM.Element (setInnerHTML)+import GHCJS.DOM.Node (appendChild)+import GHCJS.DOM.EventM (on, mouseClientXY)+import GHCJS.DOM.GlobalEventHandlers (click)++helloMain :: JSM ()+helloMain = do+    Just doc <- currentDocument+    body <- getBodyUnsafe doc+    setInnerHTML body (Just "<h1>Kia ora (Hi)</h1>")+    _ <- on doc click $ do+        (x, y) <- mouseClientXY+        newParagraph <- uncheckedCastTo HTMLParagraphElement <$> createElement doc "p"+        text <- createTextNode doc $ "Click " ++ show (x, y)+        _ <- appendChild newParagraph text+        _ <- appendChild body newParagraph+        return ()++    -- Make an exit button+    exitMVar <- liftIO newEmptyMVar+    exit <- uncheckedCastTo HTMLSpanElement <$> createElement doc "span"+    text <- createTextNode doc "Click here to exit"+    _ <- appendChild exit text+    _ <- appendChild body exit+    _ <- on exit click $ liftIO $ putMVar exitMVar ()++    -- Force all all the lazy evaluation to be executed+    syncPoint++    -- In GHC compiled version the WebSocket connection will end when this+    -- thread ends.  So we will wait until the user clicks exit.+    liftIO $ takeMVar exitMVar+    setInnerHTML body (Just "<h1>Ka kite ano (See you later)</h1>")+    return ()

@@ -1,47 +1,18 @@+{-# LANGUAGE CPP #-} module Main (     main ) where -import Control.Monad.IO.Class (MonadIO(..))-import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar)--import GHCJS.DOM (run, syncPoint, currentDocument)-import GHCJS.DOM.Types-       (HTMLParagraphElement(..), HTMLSpanElement(..), unsafeCastTo)-import GHCJS.DOM.Document (getBodyUnsafe, createElementUnsafe, createTextNode)-import GHCJS.DOM.Element (setInnerHTML)-import GHCJS.DOM.Node (appendChild)-import GHCJS.DOM.EventM (on, mouseClientXY)-import qualified GHCJS.DOM.Document as D (click)-import qualified GHCJS.DOM.Element as E (click)--main = do-  putStrLn "<a href=\"http://localhost:3708/\">http://localhost:3708/</a>"-  run 3708 $ do-    Just doc <- currentDocument-    body <- getBodyUnsafe doc-    setInnerHTML body (Just "<h1>Kia ora (Hi)</h1>")-    on doc D.click $ do-        (x, y) <- mouseClientXY-        newParagraph <- createElementUnsafe doc (Just "p") >>= unsafeCastTo HTMLParagraphElement-        text <- createTextNode doc $ "Click " ++ show (x, y)-        appendChild newParagraph text-        appendChild body (Just newParagraph)-        return ()--    -- Make an exit button-    exitMVar <- liftIO newEmptyMVar-    exit <- createElementUnsafe doc (Just "span") >>= unsafeCastTo HTMLSpanElement-    text <- createTextNode doc "Click here to exit"-    appendChild exit text-    appendChild body (Just exit)-    on exit E.click $ liftIO $ putMVar exitMVar ()+import HelloMain (helloMain)+#if defined(ghcjs_HOST_OS)+run :: a -> a+run = id+#elif defined(MIN_VERSION_jsaddle_wkwebview)+import Language.Javascript.JSaddle.WKWebView (run)+#else+import Language.Javascript.JSaddle.WebKitGTK (run)+#endif -    -- Force all all the lazy evaluation to be executed-    syncPoint+main :: IO ()+main = run helloMain -    -- In GHC compiled version the WebSocket connection will end when this-    -- thread ends.  So we will wait until the user clicks exit.-    liftIO $ takeMVar exitMVar-    setInnerHTML body (Just "<h1>Ka kite ano (See you later)</h1>")-    return ()

@@ -0,0 +1,9 @@+module Main (+    main+) where++import Language.Javascript.JSaddle.WKWebView (run)+import HelloMain (helloMain)++main :: IO ()+main = run helloMain

@@ -0,0 +1,13 @@+module Main (+    main+) where++import System.IO (stdout, hFlush)+import Language.Javascript.JSaddle.Warp (run)+import HelloMain (helloMain)++main :: IO ()+main = do+  putStrLn "<a href=\"http://localhost:3708/\">http://localhost:3708/</a>"+  hFlush stdout+  run 3708 helloMain

@@ -0,0 +1,9 @@+module Main (+    main+) where++import Language.Javascript.JSaddle.WebKitGTK (run)+import HelloMain (helloMain)++main :: IO ()+main = run helloMain