Skip to content

Instantly share code, notes, and snippets.

@Gabriella439
Last active June 1, 2022 23:45
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save Gabriella439/27209f48822880f73a2a26e851302891 to your computer and use it in GitHub Desktop.
Save Gabriella439/27209f48822880f73a2a26e851302891 to your computer and use it in GitHub Desktop.
TODO list single-page application using GHCJS
cabal-version: 3.0
name: ghcjs-demo
version: 1.0.0
license: BSD-3-Clause
executable ghcjs-demo
main-is: Main.hs
build-depends: base
, ghcjs-base
default-language: Haskell2010
<!DOCTYPE html>
<html>
<head>
<script language="javascript" src="build/rts.js"></script>
<script language="javascript" src="build/lib.js"></script>
<script language="javascript" src="build/out.js"></script>
</head>
<body>
<button id="click me" type="button">+</button>
</body>
<script language="javascript">
function replaceChildrenWorkaround(a, b) {
a.replaceChildren(...b)
}
</script>
<script language="javascript" src="build/runmain.js" defer></script>
</html>
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.JSString (JSString)
import GHCJS.Foreign.Callback (Callback)
import GHCJS.Types (JSVal)
import JavaScript.Array (JSArray)
import qualified Data.JSString as JSString
import qualified GHCJS.Foreign.Callback as Callback
import qualified JavaScript.Array as Array
foreign import javascript unsafe "document.getElementById($1)"
getElementById :: JSString -> IO JSVal
foreign import javascript unsafe "$1.textContent = $2"
setTextContent :: JSVal -> JSString -> IO ()
foreign import javascript unsafe "$1.addEventListener($2, $3)"
addEventListener :: JSVal -> JSString -> Callback (IO ()) -> IO ()
foreign import javascript unsafe "document.createElement($1)"
createElement :: JSString -> IO JSVal
foreign import javascript unsafe "$1.before($2)"
before :: JSVal -> JSVal -> IO ()
foreign import javascript unsafe "$1.setAttribute($2, $3)"
setAttribute :: JSVal -> JSString -> JSString -> IO ()
foreign import javascript unsafe "replaceChildrenWorkaround($1, $2)"
replaceChildren_ :: JSVal -> JSArray -> IO ()
replaceChildren :: JSVal -> [JSVal] -> IO ()
replaceChildren a b = replaceChildren_ a (Array.fromList b)
foreign import javascript unsafe "$1.remove()"
remove :: JSVal -> IO ()
main :: IO ()
main = do
addButton <- getElementById "click me"
addCallback <- Callback.asyncCallback do
subtractButton <- createElement "button"
setTextContent subtractButton "-"
input <- createElement "input"
setAttribute input "type" "text"
div <- createElement "div"
replaceChildren div [ subtractButton, input ]
subtractCallback <- Callback.asyncCallback (remove div)
addEventListener subtractButton "click" subtractCallback
before addButton div
addEventListener addButton "click" addCallback
let
nixpkgs = builtins.fetchTarball {
url = "https://github.com/NixOS/nixpkgs/archive/21a3136d25e1652cb32197445e9799e6a5154588.tar.gz";
sha256 = "145d474g6dngvaiwq2whqdvaq14ba9pc5pvvcz4x8l2bkwbyn3hg";
};
overlay = pkgsNew: pkgsOld: {
haskell = pkgsOld.haskell // {
packages = pkgsOld.haskell.packages // {
ghcjs = pkgsOld.haskell.packages.ghcjs.override (old: {
overrides =
let
oldOverrides = old.overrides or (_: _: {});
sourceOverrides = pkgsNew.haskell.lib.packageSourceOverrides {
ghcjs-demo = ./.;
};
in
pkgsNew.lib.composeExtensions oldOverrides sourceOverrides;
});
};
};
};
config = { };
pkgs = import nixpkgs { inherit config; overlays = [ overlay ]; };
in
pkgs.haskell.packages.ghcjs.ghcjs-demo.env
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment