From 9d67af99012275830290323c61dd8389a3386467 Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Thu, 7 May 2026 22:52:22 -0700 Subject: [PATCH 01/10] wasm --- .gitignore | 2 +- flake.lock | 73 +++++++++++++++++++++++++++++++++++++++++++++- flake.nix | 15 ++++++++-- numbersquare.cabal | 2 +- package.yaml | 4 ++- shell.nix | 8 ++++- 6 files changed, 97 insertions(+), 7 deletions(-) diff --git a/.gitignore b/.gitignore index f2fc71b..04eb3c2 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,3 @@ dist-newstyle .direnv -*.cabal \ No newline at end of file +*.cabal diff --git a/flake.lock b/flake.lock index c6c4490..63fe929 100644 --- a/flake.lock +++ b/flake.lock @@ -16,7 +16,62 @@ "type": "github" } }, + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1731533236, + "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "ghc-wasm-meta": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + }, + "locked": { + "host": "gitlab.haskell.org", + "lastModified": 1775305067, + "narHash": "sha256-KFWRYVYPgsXu51stX/7/416qc31HFltfQiHPc6nEmH0=", + "owner": "haskell-wasm", + "repo": "ghc-wasm-meta", + "rev": "60098a5076557e327b326a1a3ba3b5fb4fec1e49", + "type": "gitlab" + }, + "original": { + "host": "gitlab.haskell.org", + "owner": "haskell-wasm", + "repo": "ghc-wasm-meta", + "type": "gitlab" + } + }, "nixpkgs": { + "locked": { + "lastModified": 1774399958, + "narHash": "sha256-Q+g1Np4wyNYpylt8RFM8UprAmyRoA3q3EZj7lQV+ZuQ=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "735a15e91bcb1b3e0883a91d3c9dfd4475d1bc54", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-25.11-darwin", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_2": { "locked": { "lastModified": 1777268161, "narHash": "sha256-bxrdOn8SCOv8tN4JbTF/TXq7kjo9ag4M+C8yzzIRYbE=", @@ -35,7 +90,23 @@ "root": { "inputs": { "flake-compat": "flake-compat", - "nixpkgs": "nixpkgs" + "ghc-wasm-meta": "ghc-wasm-meta", + "nixpkgs": "nixpkgs_2" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" } } }, diff --git a/flake.nix b/flake.nix index afba6cb..425f2d0 100644 --- a/flake.nix +++ b/flake.nix @@ -3,6 +3,8 @@ inputs = { nixpkgs.url = "github:nixos/nixpkgs?ref=nixos-unstable"; + ghc-wasm-meta.url = "gitlab:haskell-wasm/ghc-wasm-meta?host=gitlab.haskell.org"; + flake-compat = { url = "github:NixOS/flake-compat"; flake = false; @@ -10,11 +12,20 @@ }; outputs = - { self, nixpkgs, ... }: + { + self, + nixpkgs, + ghc-wasm-meta, + ... + }: let pkgs = nixpkgs.legacyPackages.x86_64-linux; in { - devShells.x86_64-linux.default = pkgs.callPackage ./shell.nix { }; + inherit ghc-wasm-meta; + devShells.x86_64-linux.default = pkgs.callPackage ./shell.nix { + wasm32-wasi-cabal = ghc-wasm-meta.packages.x86_64-linux.wasm32-wasi-cabal-9_14; + wasm32-wasi-ghc = ghc-wasm-meta.packages.x86_64-linux.wasm32-wasi-ghc-9_14; + }; }; } diff --git a/numbersquare.cabal b/numbersquare.cabal index 799db3b..594931d 100644 --- a/numbersquare.cabal +++ b/numbersquare.cabal @@ -100,7 +100,7 @@ test-suite numberspec-test OverloadedLabels NamedFieldPuns TypeOperators - ghc-options: -Wall -threaded -O0 + ghc-options: -Wall -O0 build-depends: QuickCheck , array diff --git a/package.yaml b/package.yaml index 05e7b0d..4dbaee7 100644 --- a/package.yaml +++ b/package.yaml @@ -31,6 +31,8 @@ default-extensions: - NamedFieldPuns - TypeOperators +build-type: Simple + library: source-dirs: - src @@ -43,7 +45,7 @@ executable: tests: numberspec-test: main: "Main.hs" - ghc-options: "-threaded -O0" + ghc-options: "-O0" source-dirs: - test diff --git a/shell.nix b/shell.nix index 00a07b7..7f913a0 100644 --- a/shell.nix +++ b/shell.nix @@ -3,6 +3,8 @@ haskell, zlib, watchexec, + wasm32-wasi-cabal, + wasm32-wasi-ghc, }: haskellPackages.developPackage { name = "numbersquare"; @@ -12,7 +14,11 @@ haskellPackages.developPackage { addBuildTools = drv: haskell.lib.addBuildTools drv ( - [ watchexec ] + [ + watchexec + wasm32-wasi-cabal + wasm32-wasi-ghc + ] ++ (with haskellPackages; [ fourmolu haskell-language-server From 9ac87f93e98b5732159a0cfa12067dd459e03ace Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 08:56:00 -0700 Subject: [PATCH 02/10] more wasm --- Makefile | 13 +++++++++++++ out/index.html | 12 ++++++++++++ out/index.js | 28 ++++++++++++++++++++++++++++ package.yaml | 8 ++++++++ shell.nix | 11 +++++++++++ 5 files changed, 72 insertions(+) create mode 100644 Makefile create mode 100644 out/index.html create mode 100644 out/index.js diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..1dbd4d0 --- /dev/null +++ b/Makefile @@ -0,0 +1,13 @@ + +all: out/numbersquare.wasm out/ghc_wasm_jsffi.js + +out/numbersquare.wasm: app/* src/* numbersquare.cabal + wasm32-wasi-cabal build + wasm32-wasi-cabal install --installdir=out --overwrite-policy=always + +out/ghc_wasm_jsffi.js: out/numbersquare.wasm + $(shell wasm32-wasi-ghc --print-libdir)/post-link.mjs -i out/numbersquare.wasm -o out/ghc_wasm_jsffi.js + +.PHONY: clean +clean: + rm -rf dist-newstyle out/numbersquare.wasm out/ghc_wasm_jsffi.js diff --git a/out/index.html b/out/index.html new file mode 100644 index 0000000..c13272c --- /dev/null +++ b/out/index.html @@ -0,0 +1,12 @@ + + + + WASM test + + + + + + + + diff --git a/out/index.js b/out/index.js new file mode 100644 index 0000000..99b5e82 --- /dev/null +++ b/out/index.js @@ -0,0 +1,28 @@ +import { WASI, OpenFile, File, ConsoleStdout } from "https://cdn.jsdelivr.net/npm/@bjorn3/browser_wasi_shim@0.3.0/dist/index.js"; +import ghc_wasm_jsffi from "./ghc_wasm_jsffi.js" + +const args = []; +const env = ["GHCRTS=-H64m"]; +const fds = [ + new OpenFile(new File([])), // stdin + ConsoleStdout.lineBuffered((msg) => console.log(`[WASI stdout] ''${msg}`)), + ConsoleStdout.lineBuffered((msg) => console.warn(`[WASI stderr] ''${msg}`)), +]; +const options = { debug: false }; +const wasi = new WASI(args, env, fds, options); + +let __exports = {}; + +const { instance } = await WebAssembly.instantiateStreaming( + fetch("numbersquare.wasm"), + { + ghc_wasm_jsffi: ghc_wasm_jsffi(__exports), + wasi_snapshot_preview1: wasi.wasiImport, + } +); + +Object.assign(__exports, instance.exports); + +wasi.initialize(instance); +console.log(instance) +await instance.exports.hs_start(globalThis.example); diff --git a/package.yaml b/package.yaml index 4dbaee7..70af312 100644 --- a/package.yaml +++ b/package.yaml @@ -41,6 +41,14 @@ executable: source-dirs: - app main: Main.hs + when: + - condition: arch(wasm32) + ghc-options: + -no-hs-main + -optl-mexec-model=reactor + "-optl-Wl,--export=hs_start" + cpp-options: + -DWASM tests: numberspec-test: diff --git a/shell.nix b/shell.nix index 7f913a0..88b56b3 100644 --- a/shell.nix +++ b/shell.nix @@ -5,6 +5,9 @@ watchexec, wasm32-wasi-cabal, wasm32-wasi-ghc, + writeShellApplication, + nodejs, + python3, }: haskellPackages.developPackage { name = "numbersquare"; @@ -18,6 +21,14 @@ haskellPackages.developPackage { watchexec wasm32-wasi-cabal wasm32-wasi-ghc + nodejs + (writeShellApplication { + name = "dev-server"; + text = '' + python -m http.server -d ./out + ''; + runtimeInputs = [ python3 ]; + }) ] ++ (with haskellPackages; [ fourmolu From 4f104b0c457f77619d7bae1abfbe7cbf8925d0bf Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 08:56:00 -0700 Subject: [PATCH 03/10] gitignore for out dir --- out/.gitignore | 2 ++ 1 file changed, 2 insertions(+) create mode 100644 out/.gitignore diff --git a/out/.gitignore b/out/.gitignore new file mode 100644 index 0000000..8ec536e --- /dev/null +++ b/out/.gitignore @@ -0,0 +1,2 @@ +*.wasm +ghc_wasm_jsffi.js \ No newline at end of file From 9301f2211c6e9d1f0bfdf74f650c4e6c9e7163aa Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 08:56:00 -0700 Subject: [PATCH 04/10] delete cabal file it's generated by hpack --- numbersquare.cabal | 118 --------------------------------------------- 1 file changed, 118 deletions(-) delete mode 100644 numbersquare.cabal diff --git a/numbersquare.cabal b/numbersquare.cabal deleted file mode 100644 index 594931d..0000000 --- a/numbersquare.cabal +++ /dev/null @@ -1,118 +0,0 @@ -cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.38.3. --- --- see: https://github.com/sol/hpack - -name: numbersquare -version: 0.1.0 -synopsis: a game where you number square -description: a game where you number square -category: Games -author: skulk -maintainer: skulk -license: BSD3 -license-file: LICENSE -build-type: Simple - -library - exposed-modules: - Game - Types.BoardAction - Types.BoardPosition - Types.GameBoard - Types.GameMode - Types.GameState - Types.Player - other-modules: - Paths_numbersquare - hs-source-dirs: - src - default-extensions: - ImportQualifiedPost - DataKinds - FlexibleInstances - MultiParamTypeClasses - TypeFamilies - UndecidableInstances - OverloadedLabels - NamedFieldPuns - TypeOperators - ghc-options: -Wall - build-depends: - array - , base ==4.* - , binary - , containers - , display - , extra - , mtl - , optics - , random - , text - default-language: Haskell2010 - -executable numbersquare - main-is: Main.hs - other-modules: - Paths_numbersquare - hs-source-dirs: - app - default-extensions: - ImportQualifiedPost - DataKinds - FlexibleInstances - MultiParamTypeClasses - TypeFamilies - UndecidableInstances - OverloadedLabels - NamedFieldPuns - TypeOperators - ghc-options: -Wall - build-depends: - array - , base ==4.* - , binary - , containers - , display - , extra - , mtl - , optics - , random - , text - default-language: Haskell2010 - -test-suite numberspec-test - type: exitcode-stdio-1.0 - main-is: Main.hs - other-modules: - Spec - Paths_numbersquare - hs-source-dirs: - test - default-extensions: - ImportQualifiedPost - DataKinds - FlexibleInstances - MultiParamTypeClasses - TypeFamilies - UndecidableInstances - OverloadedLabels - NamedFieldPuns - TypeOperators - ghc-options: -Wall -O0 - build-depends: - QuickCheck - , array - , base ==4.* - , binary - , containers - , display - , extra - , hspec >=2.1.8 - , mtl - , numbersquare - , optics - , random - , text - default-language: Haskell2010 From 4b34e48a59d6f7c415b07e7db6a378191a6d1e6a Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 09:10:16 -0700 Subject: [PATCH 05/10] player move tests --- test/Spec.hs | 70 ++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 52 insertions(+), 18 deletions(-) diff --git a/test/Spec.hs b/test/Spec.hs index 01c162e..6263306 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -4,30 +4,64 @@ module Spec where import Data.Array (array, elems) +import Data.Sequence qualified as S import Display (displayText) +import Optics import Test.Hspec +import Types.BoardAction import Types.GameBoard import Types.GameMode (SumTo (MkSumTo), Tile (IntTile)) +import Types.GameState +import Types.Player spec :: Spec -spec = describe "gameboard" do - let tiles = - array - ((0, 0), (1, 1)) - [ ((0, 0), Just $ IntTile 1) - , ((0, 1), Just $ IntTile 2) - , ((1, 0), Just $ IntTile 3) - , ((1, 1), Just $ IntTile 4) - ] - gameBoard = MkGameBoard{width = 2, height = 2, gameMode = MkSumTo 10, cells = tiles} +spec = do + describe "gameboard" do + let tiles = + array + ((0, 0), (1, 1)) + [ ((0, 0), Just $ IntTile 1) + , ((0, 1), Just $ IntTile 2) + , ((1, 0), Just $ IntTile 3) + , ((1, 1), Just $ IntTile 4) + ] + gameBoard = MkGameBoard{width = 2, height = 2, gameMode = MkSumTo 10, cells = tiles} - it "displays correctly" do - displayText gameBoard `shouldBe` "1 2 \n3 4 \n" + it "displays correctly" do + displayText gameBoard `shouldBe` "1 2 \n3 4 \n" - it "validates a move" do - selectCheck (0, 0) (1, 1) gameBoard `shouldBe` True - selectCheck (0, 0) (0, 1) gameBoard `shouldBe` False + it "validates a move" do + selectCheck (0, 0) (1, 1) gameBoard `shouldBe` True + selectCheck (0, 0) (0, 1) gameBoard `shouldBe` False - it "clears properly" do - let cleared = clear (0, 0) (0, 1) gameBoard - elems (cells cleared) `shouldBe` [Nothing, Nothing, Just $ IntTile 3, Just $ IntTile 4] + it "clears properly" do + let cleared = clear (0, 0) (0, 1) gameBoard + elems (cells cleared) `shouldBe` [Nothing, Nothing, Just $ IntTile 3, Just $ IntTile 4] + + describe "player moves" do + let tiles = + array + ((0, 0), (1, 1)) + [ ((0, 0), Just $ IntTile 5) + , ((0, 1), Just $ IntTile 5) + , ((1, 0), Just $ IntTile 1) + , ((1, 1), Just $ IntTile 2) + ] + gameBoard = MkGameBoard{width = 2, height = 2, gameMode = MkSumTo 10, cells = tiles} + initialState = MkGameState{board = gameBoard, players = S.fromList [MkPlayerState (MkPlayerName "P1") 0]} + + it "increases score if sum equals target" do + let action = SelectSquare (0, 0) (0, 1) + newState = makeMove (MkPlayerIndex 0) action initialState + + preview (#players % ix 0 % #score) newState `shouldBe` Just 1 + + it "does not increase score if sum does not equal target" do + let invalidAction = SelectSquare (0, 0) (1, 0) + newState = makeMove (MkPlayerIndex 0) invalidAction initialState + preview (#players % ix 0 % #score) newState `shouldBe` Just 0 + + it "does not change anything if invalid player index is provided" do + let action = SelectSquare (0, 0) (0, 1) + newState = makeMove (MkPlayerIndex 99) action initialState + preview (#players % ix 99 % #score) newState `shouldBe` Nothing From 989f2d7af4fc0001d2520dac8e3b3f876cad1c83 Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 20:01:29 -0700 Subject: [PATCH 06/10] add readme --- README.org | 9 +++++++++ 1 file changed, 9 insertions(+) create mode 100644 README.org diff --git a/README.org b/README.org new file mode 100644 index 0000000..95c146f --- /dev/null +++ b/README.org @@ -0,0 +1,9 @@ +#+TITLE: Number Square + +* Number Square + +This is supposed to be a clone of [[https://www.gamesaien.com/game/fruit_box_a/][apple game]] (aka Fruit Box), with a +couple of enhancements: + +- multiple game modes +- multiplayer From c49b5b25408bb397f27a6b756eb50a3cb1686263 Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 20:14:41 -0700 Subject: [PATCH 07/10] move makeMove to Game --- src/Game.hs | 15 +++++++++++++++ src/Types/GameState.hs | 9 --------- test/Spec.hs | 1 + 3 files changed, 16 insertions(+), 9 deletions(-) diff --git a/src/Game.hs b/src/Game.hs index ca51dc9..fc5b2e2 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -1 +1,16 @@ module Game where + +import Optics +import Types.BoardAction +import Types.GameBoard +import Types.GameMode +import Types.GameState + +makeMove :: (GameMode mode) => PlayerIndex -> BoardAction -> GameState mode -> GameState mode +makeMove (MkPlayerIndex idx) (SelectSquare topLeft bottomRight) state@MkGameState{board} = + let tiles = select topLeft bottomRight board + gMode = gameMode board + in if check gMode tiles + then + over (#players % (ix idx) % #score) (+ 1) state + else state diff --git a/src/Types/GameState.hs b/src/Types/GameState.hs index a342625..6f70477 100644 --- a/src/Types/GameState.hs +++ b/src/Types/GameState.hs @@ -26,12 +26,3 @@ newGame gmode playerInfos rng = let (initialBoard, nextRng) = newRandomBoard gmode 10 10 rng playerStates = S.fromList $ map (\n -> MkPlayerState{name = n, score = 0}) playerInfos in (MkGameState initialBoard playerStates, nextRng) - -makeMove :: (GameMode mode) => PlayerIndex -> BoardAction -> GameState mode -> GameState mode -makeMove (MkPlayerIndex idx) (SelectSquare topLeft bottomRight) state@MkGameState{board} = - let tiles = select topLeft bottomRight board - gMode = gameMode board - in if check gMode tiles - then - over (#players % (ix idx) % #score) (+ 1) state - else state diff --git a/test/Spec.hs b/test/Spec.hs index 6263306..c28518f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,6 +6,7 @@ module Spec where import Data.Array (array, elems) import Data.Sequence qualified as S import Display (displayText) +import Game import Optics import Test.Hspec import Types.BoardAction From 57579fa5e4f4945614d0729af1b60575de693030 Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 20:16:48 -0700 Subject: [PATCH 08/10] fix makeMove --- src/Game.hs | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/src/Game.hs b/src/Game.hs index fc5b2e2..7898976 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -10,7 +10,11 @@ makeMove :: (GameMode mode) => PlayerIndex -> BoardAction -> GameState mode -> G makeMove (MkPlayerIndex idx) (SelectSquare topLeft bottomRight) state@MkGameState{board} = let tiles = select topLeft bottomRight board gMode = gameMode board - in if check gMode tiles - then - over (#players % (ix idx) % #score) (+ 1) state - else state + transform = + if check gMode tiles + -- add one to player score + -- TODO: add the proper score here + then over (#players % (ix idx) % #score) (+ 1) + -- invalid move, do nothing + else id + in transform state From 38838c47b919fd291414bb5d0f45349be50b8ce9 Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sat, 9 May 2026 20:32:17 -0700 Subject: [PATCH 09/10] check should return score or nothing if invalid --- src/Game.hs | 9 ++++----- src/Types/GameBoard.hs | 2 +- src/Types/GameMode.hs | 7 +++---- test/Spec.hs | 6 +++--- 4 files changed, 11 insertions(+), 13 deletions(-) diff --git a/src/Game.hs b/src/Game.hs index 7898976..712dc29 100644 --- a/src/Game.hs +++ b/src/Game.hs @@ -11,10 +11,9 @@ makeMove (MkPlayerIndex idx) (SelectSquare topLeft bottomRight) state@MkGameStat let tiles = select topLeft bottomRight board gMode = gameMode board transform = - if check gMode tiles - -- add one to player score - -- TODO: add the proper score here - then over (#players % (ix idx) % #score) (+ 1) + case check gMode tiles of + Just score -> + over (#players % (ix idx) % #score) (+ score) -- invalid move, do nothing - else id + Nothing -> id in transform state diff --git a/src/Types/GameBoard.hs b/src/Types/GameBoard.hs index 8e158fc..da81c41 100644 --- a/src/Types/GameBoard.hs +++ b/src/Types/GameBoard.hs @@ -27,7 +27,7 @@ clear topLeft bottomRight gBoard@MkGameBoard{cells} = gBoard{cells = newCells} where newCells = cells // map (,Nothing) (range (topLeft, bottomRight)) -selectCheck :: (GameMode mode) => BoardPosition -> BoardPosition -> GameBoard mode -> Bool +selectCheck :: (GameMode mode) => BoardPosition -> BoardPosition -> GameBoard mode -> Maybe Int selectCheck topLeft bottomRight board@MkGameBoard{gameMode} = check gameMode (select topLeft bottomRight board) diff --git a/src/Types/GameMode.hs b/src/Types/GameMode.hs index 994837b..976b1e5 100644 --- a/src/Types/GameMode.hs +++ b/src/Types/GameMode.hs @@ -8,7 +8,6 @@ import Data.Bifunctor (Bifunctor (first)) import Data.Kind (Type) import Display import System.Random.Stateful (Random (randomR), RandomGen) -import Types.BoardPosition {- | The type of game that is being played. @@ -19,7 +18,7 @@ that sums up to 'n'. -} class (Display (Tile t), Show (Tile t), Eq (Tile t), Eq t, Show t) => GameMode t where data Tile t :: Type - check :: t -> [Tile t] -> Bool + check :: t -> [Tile t] -> Maybe Int gen :: (RandomGen g) => t -> g -> (Tile t, g) data SumTo = MkSumTo Int @@ -28,8 +27,8 @@ data SumTo = MkSumTo Int instance GameMode SumTo where data Tile SumTo = IntTile Int deriving (Eq, Show) - check (MkSumTo n) [] = n == 0 - check (MkSumTo n) lst = n == sum (map toInt lst) + check (MkSumTo n) [] = if n == 0 then Just 0 else Nothing + check (MkSumTo n) lst = if n == sum (map toInt lst) then Just (length lst) else Nothing where toInt (IntTile a) = a gen (MkSumTo n) = first IntTile . randomR (1, n) diff --git a/test/Spec.hs b/test/Spec.hs index c28518f..78a9381 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -32,8 +32,8 @@ spec = do displayText gameBoard `shouldBe` "1 2 \n3 4 \n" it "validates a move" do - selectCheck (0, 0) (1, 1) gameBoard `shouldBe` True - selectCheck (0, 0) (0, 1) gameBoard `shouldBe` False + selectCheck (0, 0) (1, 1) gameBoard `shouldBe` Just 4 + selectCheck (0, 0) (0, 1) gameBoard `shouldBe` Nothing it "clears properly" do let cleared = clear (0, 0) (0, 1) gameBoard @@ -55,7 +55,7 @@ spec = do let action = SelectSquare (0, 0) (0, 1) newState = makeMove (MkPlayerIndex 0) action initialState - preview (#players % ix 0 % #score) newState `shouldBe` Just 1 + preview (#players % ix 0 % #score) newState `shouldBe` Just 2 it "does not increase score if sum does not equal target" do let invalidAction = SelectSquare (0, 0) (1, 0) From 77ee0c0abb384cdedc9b922d969e817558a79bde Mon Sep 17 00:00:00 2001 From: Sidharth Kulkarni Date: Sun, 10 May 2026 09:24:48 -0700 Subject: [PATCH 10/10] WASM hello world --- .gitignore | 1 + Makefile | 6 ++- app/App.hs | 19 ++++++++++ app/Main.hs | 10 ++++- cabal.project | 2 + flake.lock | 6 +-- flake.nix | 7 ++-- package.yaml | 13 ++++++- shell.nix | 103 +++++++++++++++++++++++++++++++++----------------- 9 files changed, 121 insertions(+), 46 deletions(-) create mode 100644 app/App.hs diff --git a/.gitignore b/.gitignore index 04eb3c2..9081533 100644 --- a/.gitignore +++ b/.gitignore @@ -1,3 +1,4 @@ dist-newstyle .direnv *.cabal +cabal.project.local diff --git a/Makefile b/Makefile index 1dbd4d0..ae11e0f 100644 --- a/Makefile +++ b/Makefile @@ -1,8 +1,10 @@ all: out/numbersquare.wasm out/ghc_wasm_jsffi.js -out/numbersquare.wasm: app/* src/* numbersquare.cabal - wasm32-wasi-cabal build +numbersquare.cabal: package.yaml + hpack + +out/numbersquare.wasm: app/*.hs src/*.hs numbersquare.cabal wasm32-wasi-cabal install --installdir=out --overwrite-policy=always out/ghc_wasm_jsffi.js: out/numbersquare.wasm diff --git a/app/App.hs b/app/App.hs new file mode 100644 index 0000000..d5592c3 --- /dev/null +++ b/app/App.hs @@ -0,0 +1,19 @@ +module App where + +import Reflex +import Reflex.Dom.Core + +import Language.Javascript.JSaddle + +testWidget :: + ( DomBuilder t m + , DomBuilderSpace m ~ GhcjsDomSpace + , MonadHold t m + , PostBuild t m + ) => + m () +testWidget = elAttr "div" ("class" =: "content") do + text "hello, world!" + +start :: JSM () +start = mainWidget testWidget diff --git a/app/Main.hs b/app/Main.hs index 1dc21a2..7e21299 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,4 +1,12 @@ +{-# LANGUAGE CPP #-} + module Main (main) where +import App qualified +import Language.Javascript.JSaddle +import Language.Javascript.JSaddle.Wasm qualified as W + +foreign export javascript "hs_start" main :: IO () + main :: IO () -main = putStrLn "hi" +main = W.run $ App.start diff --git a/cabal.project b/cabal.project index 4ae0262..47cdaea 100644 --- a/cabal.project +++ b/cabal.project @@ -1,2 +1,4 @@ packages: ./numbersquare.cabal tests: True + +index-state: 2025-10-11T08:08:38Z diff --git a/flake.lock b/flake.lock index 63fe929..8805c35 100644 --- a/flake.lock +++ b/flake.lock @@ -73,11 +73,11 @@ }, "nixpkgs_2": { "locked": { - "lastModified": 1777268161, - "narHash": "sha256-bxrdOn8SCOv8tN4JbTF/TXq7kjo9ag4M+C8yzzIRYbE=", + "lastModified": 1777954456, + "narHash": "sha256-hGdgeU2Nk87RAuZyYjyDjFL6LK7dAZN5RE9+hrDTkDU=", "owner": "nixos", "repo": "nixpkgs", - "rev": "1c3fe55ad329cbcb28471bb30f05c9827f724c76", + "rev": "549bd84d6279f9852cae6225e372cc67fb91a4c1", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index 425f2d0..285e15f 100644 --- a/flake.nix +++ b/flake.nix @@ -19,13 +19,12 @@ ... }: let - pkgs = nixpkgs.legacyPackages.x86_64-linux; + pkgs = import nixpkgs { system = "x86_64-linux"; }; in { - inherit ghc-wasm-meta; devShells.x86_64-linux.default = pkgs.callPackage ./shell.nix { - wasm32-wasi-cabal = ghc-wasm-meta.packages.x86_64-linux.wasm32-wasi-cabal-9_14; - wasm32-wasi-ghc = ghc-wasm-meta.packages.x86_64-linux.wasm32-wasi-ghc-9_14; + wasm32-wasi-cabal = ghc-wasm-meta.packages.x86_64-linux.wasm32-wasi-cabal-9_12; + wasm32-wasi-ghc = ghc-wasm-meta.packages.x86_64-linux.wasm32-wasi-ghc-9_12; }; }; } diff --git a/package.yaml b/package.yaml index 70af312..f35c41d 100644 --- a/package.yaml +++ b/package.yaml @@ -6,10 +6,11 @@ description: "a game where you number square" license: BSD3 author: skulk +language: GHC2021 ghc-options: "-Wall" dependencies: - - "base == 4.*" + - base - random - array - text @@ -30,6 +31,8 @@ default-extensions: - OverloadedLabels - NamedFieldPuns - TypeOperators + - BlockArguments + - OverloadedStrings build-type: Simple @@ -41,6 +44,14 @@ executable: source-dirs: - app main: Main.hs + dependencies: + - base + - reflex + - reflex-dom-core + - "ghcjs-dom == 0.9.*" + - jsaddle + - jsaddle-wasm + - ghc-experimental when: - condition: arch(wasm32) ghc-options: diff --git a/shell.nix b/shell.nix index 88b56b3..4babaa2 100644 --- a/shell.nix +++ b/shell.nix @@ -1,4 +1,5 @@ { + callPackage, haskellPackages, haskell, zlib, @@ -7,40 +8,72 @@ wasm32-wasi-ghc, writeShellApplication, nodejs, + pkg-config, python3, + fetchFromGitHub, }: -haskellPackages.developPackage { - name = "numbersquare"; - root = ./.; - modifier = - let - addBuildTools = - drv: - haskell.lib.addBuildTools drv ( - [ - watchexec - wasm32-wasi-cabal - wasm32-wasi-ghc - nodejs - (writeShellApplication { - name = "dev-server"; - text = '' - python -m http.server -d ./out - ''; - runtimeInputs = [ python3 ]; - }) - ] - ++ (with haskellPackages; [ - fourmolu - haskell-language-server - cabal-install - hpack - ghcid - cabal-fmt - hoogle - ]) - ); - addExtraLibraries = drv: haskell.lib.addExtraLibraries drv [ zlib ]; - in - drv: addExtraLibraries (addBuildTools drv); -} +let + # TODO: this information is duplicated at the bottom. need to fix that. + ghc-wasm-compat-rev = "ef21ada9436046c7b118314d0c73752253ec58e1"; + ghc-wasm-compat-src = fetchFromGitHub { + owner = "konn"; + repo = "ghc-wasm-earthly"; + rev = ghc-wasm-compat-rev; + hash = "sha256-oUf7HFLNxBZ/roFRe5q7Sz0D0ZRygu8prxEYoYuhSU8="; + }; +in +let + shell = haskellPackages.developPackage { + name = "numbersquare"; + root = ./.; + overrides = _: _: { + ghc-wasm-compat = + haskellPackages.callCabal2nix "ghc-wasm-compat" "${ghc-wasm-compat-src}/ghc-wasm-compat" + { }; + }; + modifier = + let + addBuildTools = + drv: + haskell.lib.addBuildTools drv ( + [ + watchexec + wasm32-wasi-cabal + wasm32-wasi-ghc + nodejs + pkg-config + (writeShellApplication { + name = "dev-server"; + text = '' + python -m http.server -d ./out + ''; + runtimeInputs = [ python3 ]; + }) + ] + ++ (with haskellPackages; [ + fourmolu + happy + haskell-language-server + cabal-install + hpack + ghcid + cabal-fmt + hoogle + ]) + ); + addExtraLibraries = drv: haskell.lib.addExtraLibraries drv [ zlib ]; + in + drv: addExtraLibraries (addBuildTools drv); + }; +in +shell.overrideAttrs (old: { + shellHook = (old.shellHook or "") + '' + cat > cabal.project.local <