Build ghcjs-hello with stack

.gitignore

@@ -6,3 +6,4 @@ cabal-dev
 *.chs.h
 /.shelly/
 /gtk2hs/
+.stack-work

ghcjs-hello/ghcjs-hello.cabal

@@ -9,12 +9,23 @@ flag jmacro
     Default: False
 
 executable ghcjs-hello
-    build-depends: deepseq >=1.3.0.2 && <1.4, lens -any,
-                   containers -any, random -any,
-                   template-haskell -any, base -any, blaze-html -any, filepath -any,
-                   hamlet -any, text -any, blaze-markup -any, shakespeare -any,
-                   ghcjs-dom >=0.1.1.0 && <0.2, mtl -any, sodium -any, webkit-sodium -any,
-                   jsaddle >=0.2.0.0 && <0.3
+    build-depends: base -any
+                 , blaze-html -any
+                 , blaze-markup -any
+                 , containers -any
+                 , deepseq >=1.3.0.2 && <1.5
+                 , filepath -any
+                 , ghcjs-dom >=0.1.1.0 && <0.3
+                 , hamlet -any
+                 , jsaddle >=0.3.0.0 && <0.4
+                 , lens -any
+                 , mtl -any
+                 , random -any
+                 , shakespeare -any
+                 , sodium -any
+                 , template-haskell -any
+                 , text -any
+                 , webkit-sodium -any
 
     if flag(jmacro)
         build-depends: jmacro >=0.6.3 && <0.8

mloc-js/mloc-js.cabal

@@ -7,13 +7,26 @@ license-file: ""
 data-dir: "data"
 
 library
-    build-depends: base -any, blaze-html -any, blaze-markup -any,
-                   containers >=0.5.0.0 && <0.6, filepath -any, ghcjs-dom -any,
-                   hamlet -any, hscolour >=1.20.3 && <1.21,
-                   jsc >=0.1.0.0 && <0.2, lens >=3.8.5 && <3.11, mtl -any,
-                   random >=1.0.1.1 && <1.1, sodium -any, template-haskell -any,
-                   text -any, webkit-sodium -any, gloss -any, array -any,
-                   jmacro -any
+    build-depends: array -any
+                 , base -any
+                 , blaze-html -any
+                 , blaze-markup -any
+                 , containers
+                 , filepath -any
+                 , ghcjs-dom -any
+                 , gloss -any
+                 , hamlet -any
+                 , hscolour
+                 , jmacro -any
+                 , jsaddle
+                 , lens
+                 , mtl -any
+                 , random
+                 , shakespeare
+                 , sodium -any
+                 , template-haskell -any
+                 , text -any
+                 , webkit-sodium -any
     exposed-modules: Demo.DOM Demo.JavaScriptFFI Demo.LazyLoading
                      Demo.Threading
     exposed: True
@@ -22,13 +35,26 @@ library
     other-modules: Demo.Life WebKitUtils
 
 executable mloc-js
-    build-depends: base -any, blaze-html -any, blaze-markup -any,
-                   containers >=0.5.0.0 && <0.6, filepath -any, ghcjs-dom -any,
-                   hamlet -any, hscolour >=1.20.3 && <1.21,
-                   jsc >=0.1.0.0 && <0.2, lens >=3.8.5 && <3.11, mtl -any,
-                   random >=1.0.1.1 && <1.1, sodium -any, template-haskell -any,
-                   text -any, webkit-sodium -any, gloss -any, array -any,
-                   jmacro -any
+    build-depends: array -any
+                 , base -any
+                 , blaze-html -any
+                 , blaze-markup -any
+                 , containers
+                 , filepath -any
+                 , ghcjs-dom -any
+                 , gloss -any
+                 , hamlet -any
+                 , hscolour
+                 , jmacro -any
+                 , jsaddle
+                 , lens
+                 , mtl -any
+                 , random
+                 , shakespeare
+                 , sodium -any
+                 , template-haskell -any
+                 , text -any
+                 , webkit-sodium -any
     main-is: Main.hs
     buildable: True
     hs-source-dirs: src

mloc-js/src/Demo/DOM.hs

@@ -26,17 +26,16 @@ module Demo.DOM (
     helloDOM
 ) where
 
-import GHCJS.DOM.Document (documentGetElementById)
-import GHCJS.DOM.HTMLElement
-       (htmlElementSetInnerText)
+import GHCJS.DOM.Document (getElementById)
+import GHCJS.DOM.HTMLElement (setInnerText)
 import GHCJS.DOM.Types (castToHTMLElement)
 
 helloDOM doc = do
-    maybeExample <- documentGetElementById doc "example"
+    maybeExample <- getElementById doc "example"
     case maybeExample of
-        Just example -> htmlElementSetInnerText
+        Just example -> setInnerText
                                 (castToHTMLElement example)
-                                "Hello World"
+                                (Just "Hello World")
         Nothing      -> putStrLn "Element 'example' not found"
 
 

mloc-js/src/Demo/JavaScriptFFI.hs

@@ -14,19 +14,17 @@ module Demo.JavaScriptFFI (
   , callHaskell
 ) where
 
-import GHCJS.DOM.Types
-       (WebView(..), Document(..), HTMLDivElement(..))
-import GHCJS.DOM.HTMLCanvasElement
-       (htmlCanvasElementSetHeight, htmlCanvasElementSetWidth)
-import GHCJS.DOM.Node (nodeAppendChild)
+import GHCJS.DOM (WebView(..))
+import GHCJS.DOM.Types (Document(..), HTMLDivElement(..))
+import GHCJS.DOM.HTMLCanvasElement (setHeight, setWidth)
+import GHCJS.DOM.Node (appendChild)
 import Control.Lens ((^.))
-import Language.Javascript.JSC
-       (eval, evalJM, valToNumber, fun, jsg, js, (#), (<#), runJSC_)
+import Language.Javascript.JSaddle
+       (eval, valToNumber, fun, jsg, js, (#), (<#), runJSaddle_, global)
 import WebKitUtils
 import GHCJS.DOM (webViewGetDomDocument)
 import Control.Monad.Reader (ReaderT(..))
-import GHCJS.DOM.HTMLElement
-       (htmlElementSetInnerHTML)
+import GHCJS.DOM.Element (setInnerHTML)
 import Data.Text.Lazy (unpack)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 import Text.Hamlet (shamlet)
@@ -39,38 +37,35 @@ import Language.Javascript.JMacro
 
 canvasDemo :: WebView -> Document -> HTMLDivElement -> IO ()
 canvasDemo webView doc example = do
-    htmlElementSetInnerHTML example . unpack $ renderHtml
+    setInnerHTML example . Just . unpack $ renderHtml
         [shamlet|$newline always
             <canvas #"canvas" width="600" height="400">
         |]
 
-    runJSC_ webView $ do
+    runJSaddle_ webView $ do
         document <- jsg "document"
         let getElementById = js "getElementById"
             getContext     = js "getContext"
             fillStyle      = js "fillStyle"
             fillRect       = js "fillRect"
 
         -- var canvas = document.getElementById("canvas")
-        canvas <- document ^. getElementById # ["canvas"]
+        canvas <- (#) document "getElementById" ["canvas"]
         -- var ctx = canvas.getContext("2d")
-        ctx <- canvas ^. getContext # ["2d"]
+        ctx <- (#) canvas "getContext" ["2d"]
         -- ctx.fillStyle = "#00FF00"
-        ctx ^. fillStyle <# "#008000"
+        (ctx <# "fillStyle") "#008000"
         -- ctx.fillRect( 0, 0, 150, 75 )
-        ctx ^. fillRect # ([0, 0, 100, 100] :: [Double])
+        (#) ctx "fillRect" ([0, 0, 100, 100] :: [Double])
 
 callHaskell :: WebView -> IO ()
 callHaskell webView = do
-    runJSC_ webView $ do
-        jsg "checkPrime" <# fun $ \ f this [a] -> do
+    runJSaddle_ webView $ do
+        (global <# "checkPrime") (fun $ \ f this [a] -> do
             num <- valToNumber a
             let i = round num
             liftIO . putStrLn $ "The number " ++ show i ++
                 if isPrime i
                     then " is a prime"
-                    else " is not a prime"
-        $([evalJM|for(n = 0; n != 10; ++n) checkPrime(n);|])
-
-
-
+                    else " is not a prime")
+        eval "for(n = 0; n != 10; ++n) checkPrime(n);"

mloc-js/src/Demo/LazyLoading.hs

@@ -27,8 +27,7 @@ module Demo.LazyLoading (
     lazyLoad_freecell
 ) where
 
-import GHCJS.DOM.HTMLElement
-       (htmlElementSetInnerHTML)
+import GHCJS.DOM.Element (setInnerHTML)
 import Engine (engine)
 import Freecell (mkFreecell)
 import Control.Concurrent (threadDelay, forkIO)
@@ -41,7 +40,7 @@ import Control.Monad (forever)
 --   a loader function that fetches the bundles.
 {-# NOINLINE lazyLoad_freecell #-}
 lazyLoad_freecell webView doc example = do
-    htmlElementSetInnerHTML example $
+    setInnerHTML example $ Just $
       "<div style=\""++style++"\" "++
       "id=\"freecell\" draggable=\"false\"></div>"
     unlisten <- engine webView "freecell" =<< mkFreecell

mloc-js/src/Demo/Life.hs

@@ -13,18 +13,20 @@ module Demo.Life (
     life
 ) where
 
+import GHCJS.DOM
 import GHCJS.DOM.Types
-       (HTMLDivElement(..), Document(..), WebView(..))
-import GHCJS.DOM.HTMLElement
-       (htmlElementSetInnerHTML)
+       (HTMLDivElement(..), Document(..))
+import GHCJS.DOM.Element
+       (setInnerHTML)
 import Data.Text.Lazy (unpack)
 import Text.Blaze.Html.Renderer.Text (renderHtml)
 import Text.Hamlet (shamlet)
 import GHCJS.DOM (webViewGetDomDocument)
 import Control.Monad.Reader (ReaderT(..))
-import Language.Javascript.JSC
-       (MakeValueRef(..), MakeStringRef(..), JSF(..), runJSC,
+import Language.Javascript.JSaddle
+       (MakeVal(..), MakeString(..), JSF(..), runJSaddle,
         jsg, js, js1, js4, (<#))
+import Language.Javascript.JSaddle.Value
 import Control.Lens (IndexPreservingGetter, Getter, to, (^.))
 import qualified Data.Foldable as F (Foldable(..), Foldable)
 import Graphics.Gloss
@@ -42,14 +44,14 @@ import GHC.Float (float2Double)
 life :: WebView -> Document -> HTMLDivElement -> IO ()
 life webView doc example = do
     let canvasStyle = "position:absolute; top:60; left:300; visible: hidden"
-    htmlElementSetInnerHTML example . unpack $ renderHtml
+    setInnerHTML example . Just . unpack $ renderHtml
         [shamlet|$newline always
             <div #"lifeDiv">
                 <canvas #"canvas0" width="400" height="400" style="#{canvasStyle}">
                 <canvas #"canvas1" width="400" height="400" style="#{canvasStyle}">
         |]
 
-    let getElementById :: (MakeValueRef s, MakeStringRef s) => s -> JSF
+    let getElementById :: (MakeVal s, MakeString s) => s -> JSF
         getElementById = js1 "getElementById"
         getContext     = js1 "getContext"
         fillStyle      = js "fillStyle"
@@ -58,20 +60,20 @@ life webView doc example = do
         style          = js "style"
         visibility     = js "visibility"
 
-    runJSC webView $ do
+    runJSaddle webView $ do
         document <- jsg "document"
 
         canvas0 <- document ^. getElementById "canvas0"
         canvas1 <- document ^. getElementById "canvas1"
 
         let simulate n (canvas0, canvas1) speed model = do
-                runJSC webView $ do
+                runJSaddle webView $ do
                     ctx <- canvas0 ^. getContext "2d"
-                    ctx ^. fillStyle <# "#FFFFFF" -- if n `mod` 2 == 0 then "#FFFFFF" else "#AA0000"
+                    (ctx <# "fillStyle")  "#FFFFFF" -- if n `mod` 2 == 0 then "#FFFFFF" else "#AA0000"
                     ctx ^. fillRect 0 0 600 400
                     drawPicture ctx (300,200) (render model)
-                    canvas1 ^. style . visibility <# "hidden"
-                    canvas0 ^. style . visibility <# "visible"
+                    ((canvas1 ^. style) <# "visibility") "hidden"
+                    ((canvas0 ^. style) <# "visibility") "visible"
                 threadDelay (1000000 `div` speed)
                 simulate (n+1) (canvas1, canvas0) speed (step () 1.0 model)
             drawPicture ctx orig Blank = return ()
@@ -82,7 +84,7 @@ life webView doc example = do
                                 (realToFrac $ c-a)  (realToFrac $ d-b)
                 return ()
             drawPicture ctx orig (Color c pic) = do
-                ctx ^. fillStyle <# "#0000C0"
+                (ctx <# "fillStyle") "#0000C0"
                 drawPicture ctx orig pic
             drawPicture ctx orig p = liftIO $ print p
         liftIO . forkIO $ simulate 0 (canvas0, canvas1) 10 (parseGrid $ unlines

mloc-js/src/Demo/Threading.hs

@@ -1,4 +1,7 @@
-{-# LANGUAGE TemplateHaskell, QuasiQuotes, ScopedTypeVariables, Rank2Types #-}
+{-# LANGUAGE QuasiQuotes         #-}
+{-# LANGUAGE Rank2Types          #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell     #-}
 -----------------------------------------------------------------------------
 --
 -- Module      :  Demo.Threading
@@ -15,25 +18,26 @@ module Demo.Threading (
   , isPrime
 ) where
 
-import WebKitUtils
-       (getDivElementById, getInputElementById, getImageElementById)
-import Control.Monad.Trans ( liftIO )
-import GHCJS.DOM (postGUISync)
-import GHCJS.DOM.Types
-       (Document(..), HTMLDivElement(..))
-import Control.Concurrent
-       (putMVar, tryTakeMVar, takeMVar, newEmptyMVar, threadDelay, forkIO)
-import Control.Monad (forever, forM_)
-import GHCJS.DOM.HTMLElement
-       (htmlElementSetInnerHTML, htmlElementSetInnerText)
-import Data.Text.Lazy (Text, unpack)
-import Text.Blaze.Html.Renderer.Text (renderHtml)
-import Text.Hamlet (Html, shamlet)
-import GHCJS.DOM.HTMLInputElement
-       (htmlInputElementGetValue)
-import GHCJS.DOM.Element
-       (elementSetAttribute, elementOnkeyup, elementOnkeypress,
-        elementOnkeydown)
+import           Control.Concurrent            (forkIO, newEmptyMVar, putMVar,
+                                                takeMVar, threadDelay,
+                                                tryTakeMVar)
+import           Control.Monad                 (forM_, forever)
+import           Control.Monad.Trans           (liftIO)
+import           Data.Maybe
+import           Data.Text.Lazy                (Text, unpack)
+import           GHCJS.DOM                     (postGUISync)
+import           GHCJS.DOM.Element             (keyDown, keyPress, keyUp,
+                                                setAttribute, setInnerHTML)
+import           GHCJS.DOM.EventM              (on)
+import           GHCJS.DOM.HTMLElement         (setInnerText)
+import           GHCJS.DOM.HTMLInputElement    (getValue)
+import           GHCJS.DOM.Types               (Document (..),
+                                                HTMLDivElement (..))
+import           Text.Blaze.Html.Renderer.Text (renderHtml)
+import           Text.Hamlet                   (Html, shamlet)
+import           WebKitUtils                   (getDivElementById,
+                                                getImageElementById,
+                                                getInputElementById)
 
 -- | Count to 10 slowly
 counting :: IO ()
@@ -48,7 +52,7 @@ counting = do
 
 primes :: Document -> HTMLDivElement -> IO ()
 primes doc example = do
-    htmlElementSetInnerHTML example . unpack $ renderHtml
+    setInnerHTML example . Just . unpack $ renderHtml
         [shamlet|$newline always
             <p>
                 Know any good prime numbers?
@@ -62,18 +66,18 @@ primes doc example = do
     next <- newEmptyMVar
     forkIO . forever $ do
       n <- takeMVar next
-      postGUISync . htmlElementSetInnerHTML prime . unpack $ validatePrime n
+      postGUISync . setInnerHTML prime . Just . unpack $ validatePrime n
 
     -- Something to set the next work item
     let setNext = do
-                    n <- htmlInputElementGetValue numInput
+                    n <- getValue numInput
                     tryTakeMVar next -- Discard existing next item
-                    putMVar next n
+                    putMVar next (fromMaybe "" n)
 
     -- Lets wire up some events
-    elementOnkeydown  numInput (liftIO setNext)
-    elementOnkeyup  numInput (liftIO setNext)
-    elementOnkeypress numInput (liftIO setNext)
+    on numInput keyDown (liftIO setNext)
+    on numInput keyUp (liftIO setNext)
+    on numInput keyPress (liftIO setNext)
     return ()
 
 isPrime :: Integer -> Bool