jsaddle-hello 1.0.0.0 → 2.0.0.0

raw patch · 2 files changed

+46/−21 lines, 2 filesdep +textdep −ghcjs-domdep ~jsaddle

Dependencies added: text

Dependencies removed: ghcjs-dom

Dependency ranges changed: jsaddle

Files

• jsaddle-hello.cabal +10/−9
• src/Main.hs +36/−12

@@ -1,5 +1,5 @@ name: jsaddle-hello-version: 1.0.0.0+version: 2.0.0.0 cabal-version: >=1.6 build-type: Simple license: MIT@@ -10,22 +10,23 @@ homepage: https://github.com/ghcjs/jsaddle-hello bug-reports: https://github.com/ghcjs/jsaddle-hello/issues synopsis: JSaddle Hello World, an example package-description: This is an implementation of the classic "Hello World" program using JSaddle,-             as an example of how to create a minimal JSaddle application.-             Please submit any suggestions and improvements.+description:+    This is an implementation of the classic "Hello World" program using JSaddle,+    as an example of how to create a minimal JSaddle application.+    Please submit any suggestions and improvements. category: Web author: Hamish Mackenzie-data-dir: ""  source-repository head     type: git     location: https://github.com/ghcjs/jsaddle-hello  executable jsaddle-hello-    build-depends: base >=4.2 && <5, ghcjs-dom >=0.0.7 && <0.1,-                   jsaddle >=0.1.1.4 && <0.2, lens >=4.0.7 && <5.0     main-is: Main.hs-    buildable: True+    build-depends:+        base >=4.2 && <5,+        jsaddle >=0.5.0.0 && <0.6,+        lens >=4.0.7 && <5.0,+        text >=1.2.2.1 && <1.3     hs-source-dirs: src- 

@@ -1,17 +1,41 @@-module Main (-    main-) where+module Main ( main ) where -import GHCJS.DOM (runWebGUI, postGUIAsync)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar) import Control.Lens ((^.))-import Language.Javascript.JSaddle (jsg, js, (<#), runJSaddle_)+import Language.Javascript.JSaddle+       (run, jsg, js, js1, jss, fun, valToNumber, syncPoint) -main = runWebGUI $ \ webView -> do-    let runjs = postGUIAsync . runJSaddle_ webView+main = run 3709 $ do+    doc <- jsg "document"+    doc ^. js "body" ^. jss "innerHTML" "<h1>Kia ora (Hi)</h1>" -    runjs $ do-        document <- jsg "document"-        let body = js "body"-            innerHtml = js "innerHtml"-        document ^. body ^. innerHtml <# "<h1>Hello World</h1>"+    -- Create a haskell function call back for the onclick event+    doc ^. jss "onclick" (fun $ \ _ _ [e] -> do+        x <- e ^. js "clientX" >>= valToNumber+        y <- e ^. js "clientY" >>= valToNumber+        newParagraph <- doc ^. js1 "createElement" "p"+        newParagraph ^. js1 "appendChild" (+            doc ^. js1 "createTextNode" ("Click " ++ show (x, y)))+        doc ^. js "body" ^. js1 "appendChild" newParagraph+        return ())++    -- Make an exit button+    exitMVar <- liftIO newEmptyMVar+    exit <- doc ^. js1 "createElement" "span"+    exit ^. js1 "appendChild" (+        doc ^. js1 "createTextNode" "Click here to exit")+    doc ^. js "body" ^. js1 "appendChild" exit+    exit ^. jss "onclick" (fun $ \ _ _ _ -> 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+    doc ^. js "body" ^. jss "innerHTML" "<h1>Ka kite ano (See you later)</h1>"+    return ()++