diff --git a/.gitignore b/.gitignore index 9081533..f2fc71b 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ dist-newstyle .direnv -*.cabal -cabal.project.local +*.cabal \ No newline at end of file diff --git a/Makefile b/Makefile deleted file mode 100644 index ae11e0f..0000000 --- a/Makefile +++ /dev/null @@ -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 diff --git a/README.org b/README.org deleted file mode 100644 index 95c146f..0000000 --- a/README.org +++ /dev/null @@ -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 diff --git a/app/App.hs b/app/App.hs deleted file mode 100644 index d5592c3..0000000 --- a/app/App.hs +++ /dev/null @@ -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 diff --git a/app/Main.hs b/app/Main.hs index 7e21299..1dc21a2 100644 --- a/app/Main.hs +++ b/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" diff --git a/cabal.project b/cabal.project index 47cdaea..4ae0262 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,2 @@ packages: ./numbersquare.cabal tests: True - -index-state: 2025-10-11T08:08:38Z diff --git a/flake.lock b/flake.lock index 8805c35..c6c4490 100644 --- a/flake.lock +++ b/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, - "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": 1777954456, - "narHash": "sha256-hGdgeU2Nk87RAuZyYjyDjFL6LK7dAZN5RE9+hrDTkDU=", + "lastModified": 1777268161, + "narHash": "sha256-bxrdOn8SCOv8tN4JbTF/TXq7kjo9ag4M+C8yzzIRYbE=", "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_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" + "nixpkgs": "nixpkgs" } } }, diff --git a/flake.nix b/flake.nix index 285e15f..afba6cb 100644 --- a/flake.nix +++ b/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, - ghc-wasm-meta, - ... - }: + { self, nixpkgs, ... }: let - pkgs = import nixpkgs { system = "x86_64-linux"; }; + pkgs = nixpkgs.legacyPackages.x86_64-linux; in { - 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; - }; + devShells.x86_64-linux.default = pkgs.callPackage ./shell.nix { }; }; } diff --git a/numbersquare.cabal b/numbersquare.cabal new file mode 100644 index 0000000..799db3b --- /dev/null +++ b/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 diff --git a/out/.gitignore b/out/.gitignore deleted file mode 100644 index 8ec536e..0000000 --- a/out/.gitignore +++ /dev/null @@ -1,2 +0,0 @@ -*.wasm -ghc_wasm_jsffi.js \ No newline at end of file diff --git a/out/index.html b/out/index.html deleted file mode 100644 index c13272c..0000000 --- a/out/index.html +++ /dev/null @@ -1,12 +0,0 @@ - - - - WASM test - - - - - - - - diff --git a/out/index.js b/out/index.js deleted file mode 100644 index 99b5e82..0000000 --- a/out/index.js +++ /dev/null @@ -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); diff --git a/package.yaml b/package.yaml index f35c41d..05e7b0d 100644 --- a/package.yaml +++ b/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 diff --git a/shell.nix b/shell.nix index 4babaa2..00a07b7 100644 --- a/shell.nix +++ b/shell.nix @@ -1,79 +1,29 @@ { - callPackage, haskellPackages, haskell, zlib, watchexec, - wasm32-wasi-cabal, - wasm32-wasi-ghc, - writeShellApplication, - nodejs, - pkg-config, - python3, - fetchFromGitHub, }: -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 < 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 diff --git a/src/Types/GameBoard.hs b/src/Types/GameBoard.hs index da81c41..8e158fc 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 -> Maybe Int +selectCheck :: (GameMode mode) => BoardPosition -> BoardPosition -> GameBoard mode -> Bool 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 976b1e5..994837b 100644 --- a/src/Types/GameMode.hs +++ b/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) lst = if n == sum (map toInt lst) then Just (length lst) else Nothing + check (MkSumTo n) [] = n == 0 + check (MkSumTo n) lst = n == sum (map toInt lst) where toInt (IntTile a) = a gen (MkSumTo n) = first IntTile . randomR (1, n) diff --git a/src/Types/GameState.hs b/src/Types/GameState.hs index 6f70477..a342625 100644 --- a/src/Types/GameState.hs +++ b/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 diff --git a/test/Spec.hs b/test/Spec.hs index 78a9381..01c162e 100644 --- a/test/Spec.hs +++ b/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 - 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 = 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` Just 4 - selectCheck (0, 0) (0, 1) gameBoard `shouldBe` Nothing + 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] - - 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 + it "clears properly" do + let cleared = clear (0, 0) (0, 1) gameBoard + elems (cells cleared) `shouldBe` [Nothing, Nothing, Just $ IntTile 3, Just $ IntTile 4]