Something. RUNS. !!!!!!!!!!!!!!!!!!

Author: matheus23

DeclarativeGraphics-JS.cabal

@@ -18,9 +18,18 @@ library
   exposed-modules:     Lib
   build-depends:       base >= 4.7 && < 5
                      , jsaddle-dom
+                     , ghcjs-dom
                      , DeclarativeGraphics
   default-language:    Haskell2010
 
+executable main
+    main-is: Main.hs
+    build-depends:     base >=4.2 && <5
+                     , ghcjs-dom
+                     , DeclarativeGraphics-JS
+    hs-source-dirs: app
+    ghc-options: -threaded
+
 test-suite DeclarativeGraphics-JS-test
   type:                exitcode-stdio-1.0
   hs-source-dirs:      test

app/Main.hs

@@ -0,0 +1,52 @@
+module Main where
+
+
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar)
+
+import GHCJS.DOM
+import GHCJS.DOM.Types
+import GHCJS.DOM.Document
+import GHCJS.DOM.Element
+import GHCJS.DOM.Node
+import GHCJS.DOM.EventM
+import GHCJS.DOM.GlobalEventHandlers
+import GHCJS.DOM.HTMLHyperlinkElementUtils
+
+
+main :: IO ()
+main = liftDOM helloMain
+
+helloMain :: JSM ()
+helloMain = do
+    doc <- currentDocumentUnchecked
+    body <- getBodyUnchecked doc
+    setInnerHTML body "<h1>Kia ora (Hi)</h1>"
+
+    -- Add a mouse click event handler to the document
+    _ <- 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
+
+    -- Make an exit link
+    exitMVar <- liftIO newEmptyMVar
+    exit <- uncheckedCastTo HTMLAnchorElement <$> createElement doc "a"
+    text <- createTextNode doc "Click here to exit"
+    appendChild_ exit text
+    appendChild_ body exit
+
+    -- Set an href for the link, but use preventDefault to stop it working
+    -- (demonstraights synchronous callbacks into haskell, as preventDefault
+    -- must be called inside the JavaScript event handler function).
+    setHref exit "https://github.com/ghcjs/ghcjs-dom-hello"
+    _ <- on exit click $ preventDefault >> liftIO (putMVar exitMVar ())
+
+    -- Force all all the lazy JSaddle evaluation to be executed
+    syncPoint
+
+    -- Wait until the user clicks exit.
+    liftIO $ takeMVar exitMVar
+    setInnerHTML body "<h1>Ka kite ano (See you later)</h1>"

stack.yaml

@@ -15,7 +15,16 @@
 # resolver:
 #  name: custom-snapshot
 #  location: "./custom-snapshot.yaml"
-resolver: lts-8.22
+resolver: lts-7.19
+compiler: ghcjs-0.2.1.9007019_ghc-8.0.1 # ghcjs wohoo
+compiler-check: match-exact
+
+setup-info:
+  ghcjs:
+    source:
+      ghcjs-0.2.1.9007019_ghc-8.0.1:
+           url: http://ghcjs.tolysz.org/ghc-8.0-2017-02-05-lts-7.19-9007019.tar.gz
+           sha1: d2cfc25f9cda32a25a87d9af68891b2186ee52f9
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -41,7 +50,11 @@ packages:
 
 # Dependency packages to be pulled from upstream that are not in the resolver
 # (e.g., acme-missiles-0.3)
-extra-deps: []
+extra-deps:
+- jsaddle-0.9.0.0
+- jsaddle-dom-0.9.0.0
+- ghcjs-dom-0.9.1.1
+- ghcjs-dom-jsffi-0.9.1.1
 
 # Override default flag values for local packages and extra-deps
 flags: {}

test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "test"