.gitignore

@@ -1,4 +1,3 @@
 dist-newstyle
 .direnv
-*.cabal
+*.cabal
-cabal.project.local

Makefile

@@ -1,15 +0,0 @@
-
-all: out/numbersquare.wasm out/ghc_wasm_jsffi.js
-
-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
-	$(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

README.org

@@ -1,9 +0,0 @@
-#+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

app/App.hs

@@ -1,19 +0,0 @@
-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

app/Main.hs

@@ -1,12 +1,4 @@
-{-# 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 = W.run $ App.start
+main = putStrLn "hi"

cabal.project

@@ -1,4 +1,2 @@
 packages: ./numbersquare.cabal
 tests: True
-
-index-state: 2025-10-11T08:08:38Z

flake.lock

@@ -16,68 +16,13 @@
         "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,
+        "lastModified": 1777268161,
-        "narHash": "sha256-Q+g1Np4wyNYpylt8RFM8UprAmyRoA3q3EZj7lQV+ZuQ=",
+        "narHash": "sha256-bxrdOn8SCOv8tN4JbTF/TXq7kjo9ag4M+C8yzzIRYbE=",
-        "owner": "NixOS",
-        "repo": "nixpkgs",
-        "rev": "735a15e91bcb1b3e0883a91d3c9dfd4475d1bc54",
-        "type": "github"
-      },
-      "original": {
-        "owner": "NixOS",
-        "ref": "nixpkgs-25.11-darwin",
-        "repo": "nixpkgs",
-        "type": "github"
-      }
-    },
-    "nixpkgs_2": {
-      "locked": {
-        "lastModified": 1777954456,
-        "narHash": "sha256-hGdgeU2Nk87RAuZyYjyDjFL6LK7dAZN5RE9+hrDTkDU=",
         "owner": "nixos",
         "repo": "nixpkgs",
-        "rev": "549bd84d6279f9852cae6225e372cc67fb91a4c1",
+        "rev": "1c3fe55ad329cbcb28471bb30f05c9827f724c76",
         "type": "github"
       },
       "original": {
@@ -90,23 +35,7 @@
     "root": {
       "inputs": {
         "flake-compat": "flake-compat",
-        "ghc-wasm-meta": "ghc-wasm-meta",
+        "nixpkgs": "nixpkgs"
-        "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"
       }
     }
   },

flake.nix

@@ -3,8 +3,6 @@
 
   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;
@@ -12,19 +10,11 @@
   };
 
   outputs =
-    {
+    { self, nixpkgs, ... }:
-      self,
-      nixpkgs,
-      ghc-wasm-meta,
-      ...
-    }:
     let
-      pkgs = import nixpkgs { system = "x86_64-linux"; };
+      pkgs = nixpkgs.legacyPackages.x86_64-linux;
     in
     {
-      devShells.x86_64-linux.default = pkgs.callPackage ./shell.nix {
+      devShells.x86_64-linux.default = pkgs.callPackage ./shell.nix { };
-        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;
-      };
     };
 }

numbersquare.cabal

@@ -0,0 +1,118 @@
+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 -threaded -O0
+  build-depends:
+      QuickCheck
+    , array
+    , base ==4.*
+    , binary
+    , containers
+    , display
+    , extra
+    , hspec >=2.1.8
+    , mtl
+    , numbersquare
+    , optics
+    , random
+    , text
+  default-language: Haskell2010

out/.gitignore

@@ -1,2 +0,0 @@
-*.wasm
-ghc_wasm_jsffi.js

out/index.html

@@ -1,12 +0,0 @@
-<!DOCTYPE HTML>
-<html lang="en">
-    <head>
-        <title>WASM test</title>
-        <meta charset="utf-8">
-        <meta name="viewport" content="width=device-width, initial-scale=1">
-    </head>
-
-    <body>
-        <script src="./index.js" type="module"></script>
-    </body>
-</html>

out/index.js

@@ -1,28 +0,0 @@
-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);

package.yaml

@@ -6,11 +6,10 @@ description: "a game where you number square"
 license: BSD3
 author: skulk
 
-language: GHC2021
 ghc-options: "-Wall"
 
 dependencies:
-  - base
+  - "base == 4.*"
   - random
   - array
   - text
@@ -31,10 +30,6 @@ default-extensions:
   - OverloadedLabels
   - NamedFieldPuns
   - TypeOperators
-  - BlockArguments
-  - OverloadedStrings
-
-build-type: Simple
 
 library:
   source-dirs:
@@ -44,27 +39,11 @@ 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:
-        -no-hs-main
-        -optl-mexec-model=reactor
-        "-optl-Wl,--export=hs_start"
-      cpp-options:
-        -DWASM
 
 tests:
   numberspec-test:
     main: "Main.hs"
-    ghc-options: "-O0"
+    ghc-options: "-threaded -O0"
     source-dirs:
       - test
 

shell.nix

@@ -1,79 +1,29 @@
 {
-  callPackage,
   haskellPackages,
   haskell,
   zlib,
   watchexec,
-  wasm32-wasi-cabal,
-  wasm32-wasi-ghc,
-  writeShellApplication,
-  nodejs,
-  pkg-config,
-  python3,
-  fetchFromGitHub,
 }:
-let
+haskellPackages.developPackage {
-  # TODO: this information is duplicated at the bottom. need to fix that.
+  name = "numbersquare";
-  ghc-wasm-compat-rev = "ef21ada9436046c7b118314d0c73752253ec58e1";
+  root = ./.;
-  ghc-wasm-compat-src = fetchFromGitHub {
+  modifier =
-    owner = "konn";
+    let
-    repo = "ghc-wasm-earthly";
+      addBuildTools =
-    rev = ghc-wasm-compat-rev;
+        drv:
-    hash = "sha256-oUf7HFLNxBZ/roFRe5q7Sz0D0ZRygu8prxEYoYuhSU8=";
+        haskell.lib.addBuildTools drv (
-  };
+          [ watchexec ]
-in
+          ++ (with haskellPackages; [
-let
+            fourmolu
-  shell = haskellPackages.developPackage {
+            haskell-language-server
-    name = "numbersquare";
+            cabal-install
-    root = ./.;
+            hpack
-    overrides = _: _: {
+            ghcid
-      ghc-wasm-compat =
+            cabal-fmt
-        haskellPackages.callCabal2nix "ghc-wasm-compat" "${ghc-wasm-compat-src}/ghc-wasm-compat"
+            hoogle
-          { };
+          ])
-    };
+        );
-    modifier =
+      addExtraLibraries = drv: haskell.lib.addExtraLibraries drv [ zlib ];
-      let
+    in
-        addBuildTools =
+    drv: addExtraLibraries (addBuildTools drv);
-          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 <<EOF
-    source-repository-package
-      type: git
-      location: https://github.com/konn/ghc-wasm-earthly
-      tag: ${ghc-wasm-compat-rev}
-      subdir: ghc-wasm-compat
-    EOF
-  '';
-})

src/Game.hs

@@ -1,19 +1 @@
 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
-        transform =
-            case check gMode tiles of
-                Just score ->
-                    over (#players % (ix idx) % #score) (+ score)
-                -- invalid move, do nothing
-                Nothing -> id
-     in transform state

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 -> Maybe Int
+selectCheck :: (GameMode mode) => BoardPosition -> BoardPosition -> GameBoard mode -> Bool
 selectCheck topLeft bottomRight board@MkGameBoard{gameMode} =
     check gameMode (select topLeft bottomRight board)
 

src/Types/GameMode.hs

@@ -8,6 +8,7 @@ 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.
 
@@ -18,7 +19,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] -> Maybe Int
+    check :: t -> [Tile t] -> Bool
     gen :: (RandomGen g) => t -> g -> (Tile t, g)
 
 data SumTo = MkSumTo Int
@@ -27,8 +28,8 @@ data SumTo = MkSumTo Int
 instance GameMode SumTo where
     data Tile SumTo = IntTile Int deriving (Eq, Show)
 
-    check (MkSumTo n) [] = if n == 0 then Just 0 else Nothing
+    check (MkSumTo n) [] = n == 0
-    check (MkSumTo n) lst = if n == sum (map toInt lst) then Just (length lst) else Nothing
+    check (MkSumTo n) lst = n == sum (map toInt lst)
       where
         toInt (IntTile a) = a
     gen (MkSumTo n) = first IntTile . randomR (1, n)

src/Types/GameState.hs

@@ -26,3 +26,12 @@ 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

test/Spec.hs

@@ -4,65 +4,30 @@
 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
 import Types.GameBoard
 import Types.GameMode (SumTo (MkSumTo), Tile (IntTile))
-import Types.GameState
-import Types.Player
 
 spec :: Spec
-spec = do
+spec = describe "gameboard" do
-    describe "gameboard" do
+    let tiles =
-        let tiles =
+            array
-                array
+                ((0, 0), (1, 1))
-                    ((0, 0), (1, 1))
+                [ ((0, 0), Just $ IntTile 1)
-                    [ ((0, 0), Just $ IntTile 1)
+                , ((0, 1), Just $ IntTile 2)
-                    , ((0, 1), Just $ IntTile 2)
+                , ((1, 0), Just $ IntTile 3)
-                    , ((1, 0), Just $ IntTile 3)
+                , ((1, 1), Just $ IntTile 4)
-                    , ((1, 1), Just $ IntTile 4)
+                ]
-                    ]
+        gameBoard = MkGameBoard{width = 2, height = 2, gameMode = MkSumTo 10, cells = tiles}
-            gameBoard = MkGameBoard{width = 2, height = 2, gameMode = MkSumTo 10, cells = tiles}
 
-        it "displays correctly" do
+    it "displays correctly" do
-            displayText gameBoard `shouldBe` "1 2 \n3 4 \n"
+        displayText gameBoard `shouldBe` "1 2 \n3 4 \n"
 
-        it "validates a move" do
+    it "validates a move" do
-            selectCheck (0, 0) (1, 1) gameBoard `shouldBe` Just 4
+        selectCheck (0, 0) (1, 1) gameBoard `shouldBe` True
-            selectCheck (0, 0) (0, 1) gameBoard `shouldBe` Nothing
+        selectCheck (0, 0) (0, 1) gameBoard `shouldBe` False
 
-        it "clears properly" do
+    it "clears properly" do
-            let cleared = clear (0, 0) (0, 1) gameBoard
+        let cleared = clear (0, 0) (0, 1) gameBoard
-            elems (cells cleared) `shouldBe` [Nothing, Nothing, Just $ IntTile 3, Just $ IntTile 4]
+        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 2
-
-        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