level + ci

Author: Julien Dehos

.github/workflows/main.yml

@@ -42,7 +42,7 @@ jobs:
       - name: Build using Nix
         run: |
           export NIX_PATH=nixpkgs=https://github.com/NixOS/nixpkgs/archive/refs/tags/25.05.tar.gz
-          nix-shell --run "cabal run"
+          nix-shell --run "cabal build"
 
   build-dev:
     runs-on: ubuntu-latest
@@ -55,7 +55,7 @@ jobs:
           github_access_token: ${{ secrets.GITHUB_TOKEN }}
 
       - name: Build using Nix
-        run: nix develop .#default --command bash -c "cabal update && cabal run"
+        run: nix develop .#default --command bash -c "cabal update && cabal build"
 
   deploy:
     runs-on: ubuntu-latest

src/Component.hs

@@ -12,9 +12,11 @@ import Miso.Lens
 import Miso.Html.Element as H
 import Miso.Html.Event as E
 import Miso.Html.Property as P
+import Miso.String (fromMisoStringEither)
 
 import Model
 import Game
+import GeneratedWorlds (allWorlds)
 
 -------------------------------------------------------------------------------
 -- params
@@ -30,6 +32,7 @@ assetsUrl = "assets/"
 data Action
   = ActionSetLevel Int
   | ActionKey IS.IntSet
+  | ActionAskLevel MisoString
 
 -------------------------------------------------------------------------------
 -- update
@@ -54,6 +57,11 @@ updateModel (ActionKey keys)
         modelGame .= g
         modelNbMoves += 1
 
+updateModel (ActionAskLevel lStr) = do
+  case fromMisoStringEither lStr of
+    Left err -> io_ $ consoleLog $ ms err
+    Right l -> issue $ ActionSetLevel l
+
 -------------------------------------------------------------------------------
 -- resources
 -------------------------------------------------------------------------------
@@ -91,8 +99,9 @@ viewModel :: Model -> View Model Action
 viewModel m@Model{..} = 
   div_ []
     [ p_ [] 
-        [ button_ [ onClick (ActionSetLevel $ getLevel _modelGame) ] [ "reset" ] 
-        , button_ [ onClick (ActionSetLevel $ 1 + getLevel _modelGame) ] [ "next" ] 
+       [ select_ [ onChange ActionAskLevel ] (map fmtOption [1 .. length allWorlds])
+        , button_ [ onClick (ActionSetLevel $ getLevel _modelGame) ] [ "new game" ] 
+        , button_ [ onClick (ActionSetLevel $ 1 + getLevel _modelGame) ] [ "next level" ] 
         ]
     , p_ [] [ text ("nb moves: " <> ms (show _modelNbMoves) <> status) ]
     , Canvas.canvas
@@ -104,8 +113,15 @@ viewModel m@Model{..} =
     ]
   where
     (w, h) = ij2xy $ getNiNj _modelGame
+
     status = if computeRunning _modelGame then "" else ", done !!!"
 
+    fmtOption l = 
+      let lStr = ms $ show l
+      in option_
+          [ selected_ (getLevel _modelGame == l), value_ lStr ]
+          [ text ("level " <> lStr) ]
+
 initCanvas :: DOMRef -> Canvas Resources
 initCanvas _ = liftJSM $ 
   Resources <$> newImage (assetsUrl <> "box1.png")