jsaddle-hello 2.0.0.0 → 2.0.0.1
raw patch · 7 files changed
+140/−51 lines, 7 filesdep +jsaddle-hellodep +jsaddle-warpdep +jsaddle-webkit2gtkdep ~jsaddledep ~lensbuild-type:Customsetup-changednew-component:exe:jsaddle-hello-webkitgtknew-component:exe:jsaddle-hello-wkwebview
Dependencies added: jsaddle-hello, jsaddle-warp, jsaddle-webkit2gtk, jsaddle-wkwebview
Dependency ranges changed: jsaddle, lens
Files
- Setup.hs +13/−3
- jsaddle-hello.cabal +53/−7
- src-exe/WKWebViewMain.hs +6/−0
- src-exe/WarpMain.hs +6/−0
- src-exe/WebKitGTKMain.hs +6/−0
- src/JSaddleHello.hs +56/−0
- src/Main.hs +0/−41
Setup.hs view
@@ -1,6 +1,16 @@-module Main (main) where-+import Distribution.MacOSX import Distribution.Simple main :: IO ()-main = defaultMain+main = defaultMainWithHooks $ simpleUserHooks {+ postBuild = appBundleBuildHook guiApps -- no-op if not MacOS X+ }++guiApps :: [MacApp]+guiApps = [MacApp "jsaddle-hello-wkwebview"+ Nothing+ (Just "macos/Info.plist")+ [] -- No other resources.+ [] -- No other binaries.+ DoNotChase -- Try changing to ChaseWithDefaults+ ]
jsaddle-hello.cabal view
@@ -1,7 +1,7 @@+cabal-version: 3.0 name: jsaddle-hello-version: 2.0.0.0-cabal-version: >=1.6-build-type: Simple+version: 2.0.0.1+build-type: Custom license: MIT license-file: LICENSE copyright: (c) Hamish Mackenzie@@ -21,12 +21,58 @@ type: git location: https://github.com/ghcjs/jsaddle-hello -executable jsaddle-hello- main-is: Main.hs+custom-setup+ setup-depends: base >= 4.6,+ Cabal >= 3.0 && < 3.5,+ cabal-macosx >= 0.2.3.4 && < 0.3++library build-depends: base >=4.2 && <5,- jsaddle >=0.5.0.0 && <0.6,- lens >=4.0.7 && <5.0,+ jsaddle >=0.8.0.0 && <0.10,+ lens >=4.0.7 && <5.1, text >=1.2.2.1 && <1.3+ exposed-modules: JSaddleHello hs-source-dirs: src+ default-language: Haskell2010++executable jsaddle-hello+ main-is: WarpMain.hs+ build-depends:+ base >=4.2 && <5,+ jsaddle-hello -any,+ jsaddle-warp >=0.8.0.0 && <0.10,+ lens >=4.0.7 && <5.1,+ text >=1.2.2.1 && <1.3+ hs-source-dirs: src-exe+ ghc-options: -threaded+ default-language: Haskell2010++executable jsaddle-hello-webkitgtk+ if impl(ghcjs)+ buildable: False+ main-is: WebKitGTKMain.hs+ build-depends:+ base >=4.2 && <5,+ jsaddle-hello -any,+ jsaddle-webkit2gtk >=0.8.0.0 && <0.10,+ lens >=4.0.7 && <5.1,+ text >=1.2.2.1 && <1.3+ hs-source-dirs: src-exe+ ghc-options: -threaded+ default-language: Haskell2010++executable jsaddle-hello-wkwebview+ if !os(osx) || impl(ghcjs)+ buildable: False+ main-is: WKWebViewMain.hs+ build-depends:+ base >=4.2 && <5,+ jsaddle-hello -any,+ jsaddle-wkwebview >=0.8.1.0 && <0.10,+ lens >=4.0.7 && <5.1,+ text >=1.2.2.1 && <1.3+ hs-source-dirs: src-exe+ ghc-options: -threaded+ default-language: Haskell2010
+ src-exe/WKWebViewMain.hs view
@@ -0,0 +1,6 @@+module Main ( main ) where++import qualified JSaddleHello (main)+import Language.Javascript.JSaddle.WKWebView (run)++main = run JSaddleHello.main
+ src-exe/WarpMain.hs view
@@ -0,0 +1,6 @@+module Main ( main ) where++import qualified JSaddleHello (main)+import Language.Javascript.JSaddle.Warp (run)++main = run 3709 JSaddleHello.main
+ src-exe/WebKitGTKMain.hs view
@@ -0,0 +1,6 @@+module Main ( main ) where++import qualified JSaddleHello (main)+import Language.Javascript.JSaddle.WebKitGTK (run)++main = run JSaddleHello.main
+ src/JSaddleHello.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE ScopedTypeVariables #-}+module JSaddleHello ( main ) where++import Data.Monoid ((<>))+import Control.Monad (forever)+import Control.Monad.IO.Class (MonadIO(..))+import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar)+import Control.Lens ((^.))+import Language.Javascript.JSaddle+ (jsg, jsg3, js, js1, jss, fun, valToNumber, syncPoint,+ nextAnimationFrame, runJSM, askJSM, global)++main = do+ doc <- jsg "document"+ doc ^. js "body" ^. jss "innerHTML" "<h1>Kia ora (Hi)</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++ -- Animate the color of the exit button+ ctx <- askJSM+ liftIO . forkIO . forever $+ (`runJSM` ctx) . nextAnimationFrame $ \ t -> do+ let n = floor ((sin (3 * t) + 1) * 128)+ (h1, h2) = n `divMod` 16+ hexDigits = ['0'..'9'] <> ['A'..'F']+ exit ^. js "style" ^. jss "color" ("#0000" <> [hexDigits !! h1, hexDigits !! h2])+ return ()++ -- 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 ()+++
− src/Main.hs
@@ -1,41 +0,0 @@-module Main ( main ) where--import Control.Monad.IO.Class (MonadIO(..))-import Control.Concurrent.MVar (takeMVar, putMVar, newEmptyMVar)-import Control.Lens ((^.))-import Language.Javascript.JSaddle- (run, jsg, js, js1, jss, fun, valToNumber, syncPoint)--main = run 3709 $ do- doc <- jsg "document"- doc ^. js "body" ^. jss "innerHTML" "<h1>Kia ora (Hi)</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 ()---