swarm 0.1.1.0 → 0.2.0.0

raw patch · 44 files changed

+1117/−554 lines, 44 filesdep +natural-sortdep +taggeddep +text-zipperdep −entropydep ~aesondep ~basedep ~brickPVP ok

version bump matches the API change (PVP)

Dependencies added: natural-sort, tagged, text-zipper

Dependencies removed: entropy

Dependency ranges changed: aeson, base, brick, lens, lsp, template-haskell, vector, vty, witch

API changes (from Hackage documentation)

Files

• CHANGELOG.md +37/−0
• app/Main.hs +40/−5
• data/scenarios/Challenges/Mazes/easy_cave_maze.yaml +0/−2
• data/scenarios/Challenges/Mazes/easy_spiral_maze.yaml +0/−2
• data/scenarios/Challenges/hanoi.yaml +0/−6
• data/scenarios/Challenges/teleport.yaml +0/−4
• data/scenarios/Testing/562-lodestone.sw +4/−1
• data/scenarios/Testing/562-lodestone.yaml +8/−7
• data/scenarios/Tutorials/backstory.yaml +4/−1
• data/scenarios/Tutorials/build.yaml +2/−1
• data/scenarios/Tutorials/crash-secret.sw +1/−1
• data/scenarios/Tutorials/crash.yaml +10/−10
• data/scenarios/Tutorials/grab.yaml +4/−3
• data/scenarios/Tutorials/move.yaml +8/−71
• data/scenarios/Tutorials/requireinv.yaml +5/−6
• data/scenarios/Tutorials/scan.yaml +1/−1
• data/scenarios/Tutorials/types.yaml +1/−2
• editors/emacs/swarm-mode.el +1/−1
• editors/vscode/syntaxes/swarm.tmLanguage.json +6/−8
• src/Swarm/App.hs +4/−2
• src/Swarm/DocGen.hs +184/−16
• src/Swarm/Game/Display.hs +17/−8
• src/Swarm/Game/Entity.hs +5/−4
• src/Swarm/Game/Robot.hs +35/−5
• src/Swarm/Game/Scenario.hs +9/−5
• src/Swarm/Game/ScenarioInfo.hs +6/−3
• src/Swarm/Game/State.hs +66/−16
• src/Swarm/Game/Step.hs +11/−7
• src/Swarm/Game/World.hs +2/−2
• src/Swarm/Game/WorldGen.hs +5/−1
• src/Swarm/Language/Parse.hs +4/−2
• src/Swarm/Language/Pretty.hs +1/−0
• src/Swarm/Language/Typecheck.hs +1/−0
• src/Swarm/Language/Typed.hs +20/−0
• src/Swarm/Language/Types.hs +11/−1
• src/Swarm/TUI/Controller.hs +192/−114
• src/Swarm/TUI/Inventory/Sorting.hs +77/−0
• src/Swarm/TUI/Model.hs +173/−133
• src/Swarm/TUI/View.hs +120/−49
• src/Swarm/Version.hs +6/−35
• swarm.cabal +16/−16
• test/integration/Main.hs +3/−3
• test/unit/TestLanguagePipeline.hs +12/−0
• test/unit/TestPretty.hs +5/−0

@@ -1,5 +1,42 @@ # Revision history for swarm +## **0.2.0.0** - 2022-11-01++A bunch of small fixes and improvements; special thanks to new+contributors @0xcefaedfe, @kostmo, @ussgarci, and @valyagolev. Notable changes include:++- New UI features:+    - REPL improvements:+        - Expose the last evaluated result as `it`, and previous results+          as `itN` ([#734](https://github.com/swarm-game/swarm/pull/734))+        - Allow clicking in the REPL input to move the cursor+          ([#750](https://github.com/swarm-game/swarm/pull/750))+        - Autocomplete entity names in the repl ([#798](https://github.com/swarm-game/swarm/pull/798))+        - REPL cursor no longer blinks when REPL panel is not selected ([#801](https://github.com/swarm-game/swarm/pull/801))+    - Improve user experience around quitting & moving between+      tutorial challenges ([#754](https://github.com/swarm-game/swarm/pull/754))+        - Add a button to the Quit dialog to restart a+          scenario. ([#767](https://github.com/swarm-game/swarm/pull/767))+        - Use scenario name as Goal dialog title ([#774](https://github.com/swarm-game/swarm/pull/774))+    - `autoplay` flag for automatically demonstrating scenario+      solutions ([#792](https://github.com/swarm-game/swarm/pull/792))+    - Improved inventory sorting and user-controllable sort criteria ([#793](https://github.com/swarm-game/swarm/pull/793))+    - Ability to temporarily hide robots so you can see what's under+      them ([#802](https://github.com/swarm-game/swarm/pull/802))+- New language features:+    - New `void` type ([#735](https://github.com/swarm-game/swarm/pull/735))+- Bug fixes:+    - Fix bug in the first tutorial challenge that froze the game and+      ate all memory if the user said anything other than expected+      ([#762](https://github.com/swarm-game/swarm/pull/762), [#810](https://github.com/swarm-game/swarm/pull/810))+- Documentation:+    - Generate all wiki "cheat sheets" automatically ([#769](https://github.com/swarm-game/swarm/pull/769))+- Support for building on GHC 9.4 ([#752](https://github.com/swarm-game/swarm/pull/752))++There were several other small fixes and improvements; see the [full+changelog+here](https://github.com/swarm-game/swarm/compare/0.1.1.0...0.2.0.0).+ ## **0.1.1.0** - 2022-10-14  A couple new features and an important bugfix for the Hackage release.

@@ -1,13 +1,17 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}  module Main where  import Data.Foldable qualified+import Data.Maybe (fromMaybe) import Data.Text (Text, pack)+import Data.Text qualified as T import Data.Text.IO qualified as Text+import GitHash (GitInfo, giBranch, giHash, tGitInfoCwdTry) import Options.Applicative import Swarm.App (appMain)-import Swarm.DocGen (EditorType (..), GenerateDocs (..), SheetType (..), generateDocs)+import Swarm.DocGen (EditorType (..), GenerateDocs (..), PageAddress (..), SheetType (..), generateDocs) import Swarm.Language.LSP (lspMain) import Swarm.Language.Pipeline (processTerm) import Swarm.TUI.Model (AppOpts (..))@@ -16,6 +20,14 @@ import System.Exit (exitFailure, exitSuccess) import System.IO (hPrint, stderr) +gitInfo :: Maybe GitInfo+gitInfo = either (const Nothing) Just ($$tGitInfoCwdTry)++commitInfo :: String+commitInfo = case gitInfo of+  Nothing -> ""+  Just git -> " (" <> giBranch git <> "@" <> take 10 (giHash git) <> ")"+ data CLI   = Run AppOpts   | Format Input@@ -33,7 +45,7 @@         , command "version" (info (pure Version) (progDesc "Get current and upstream version."))         ]     )-    <|> Run <$> (AppOpts <$> seed <*> scenario <*> run <*> cheat <*> webPort)+    <|> Run <$> (AppOpts <$> seed <*> scenario <*> run <*> autoplay <*> cheat <*> webPort <*> pure gitInfo)  where   format :: Parser CLI   format =@@ -44,7 +56,7 @@     subparser . mconcat $       [ command "recipes" (info (pure RecipeGraph) $ progDesc "Output graphviz dotfile of entity dependencies based on recipes")       , command "editors" (info (EditorKeywords <$> editor <**> helper) $ progDesc "Output editor keywords")-      , command "cheatsheet" (info (pure $ CheatSheet $ Just Commands) $ progDesc "Output nice Wiki tables")+      , command "cheatsheet" (info (CheatSheet <$> address <*> cheatsheet <**> helper) $ progDesc "Output nice Wiki tables")       ]   editor :: Parser (Maybe EditorType)   editor =@@ -53,6 +65,27 @@       , Just VSCode <$ switch (long "code" <> help "Generate for the VS Code editor")       , Just Emacs <$ switch (long "emacs" <> help "Generate for the Emacs editor")       ]+  address :: Parser PageAddress+  address =+    let replace a b = T.unpack . T.replace a b . T.pack+        opt n =+          fmap (fromMaybe "") . optional $+            option+              str+              ( long n+                  <> metavar "ADDRESS"+                  <> help ("Set the address of " <> replace "-" " " n <> ". Default no link.")+              )+     in PageAddress <$> opt "entities-page" <*> opt "commands-page" <*> opt "capabilities-page" <*> opt "recipes-page"+  cheatsheet :: Parser (Maybe SheetType)+  cheatsheet =+    Data.Foldable.asum+      [ pure Nothing+      , Just Entities <$ switch (long "entities" <> help "Generate entities page (uses data from entities.yaml)")+      , Just Recipes <$ switch (long "recipes" <> help "Generate recipes page (uses data from recipes.yaml)")+      , Just Capabilities <$ switch (long "capabilities" <> help "Generate capabilities page (uses entity map)")+      , Just Commands <$ switch (long "commands" <> help "Generate commands page (uses constInfo, constCaps and inferConst)")+      ]   seed :: Parser (Maybe Int)   seed = optional $ option auto (long "seed" <> short 's' <> metavar "INT" <> help "Seed to use for world generation")   webPort :: Parser (Maybe Int)@@ -68,8 +101,10 @@   scenario = optional $ strOption (long "scenario" <> short 'c' <> metavar "FILE" <> help "Name of a scenario to load")   run :: Parser (Maybe String)   run = optional $ strOption (long "run" <> short 'r' <> metavar "FILE" <> help "Run the commands in a file at startup")+  autoplay :: Parser Bool+  autoplay = switch (long "autoplay" <> short 'a' <> help "Automatically run the solution defined in the scenario, if there is one. Mutually exclusive with --run.")   cheat :: Parser Bool-  cheat = switch (long "cheat" <> short 'x' <> help "Enable cheat mode")+  cheat = switch (long "cheat" <> short 'x' <> help "Enable cheat mode. This allows toggling Creative Mode with Ctrl+v and unlocks \"Testing\" scenarios in the menu.")  cliInfo :: ParserInfo CLI cliInfo =@@ -105,7 +140,7 @@ showVersion :: IO () showVersion = do   putStrLn $ "Swarm game - " <> version <> commitInfo-  up <- getNewerReleaseVersion+  up <- getNewerReleaseVersion gitInfo   either (hPrint stderr) (putStrLn . ("New upstream release: " <>)) up  main :: IO ()

@@ -45,8 +45,6 @@   - name: judge     dir: [0,0]     system: true-    display:-      invisible: true     program: |       def until = \c. b <- c; if b {} {until c} end;       until (d <- scan down; return (d == inl ()));

@@ -46,8 +46,6 @@   - name: judge     dir: [0,0]     system: true-    display:-      invisible: true     program: |       def until = \c. b <- c; if b {} {until c} end;       until (d <- scan down; return (d == inl ()));

@@ -37,8 +37,6 @@   - name: invariant     dir: [0,0]     system: true-    display:-      invisible: true     devices:     - logger     inventory:@@ -66,8 +64,6 @@   - name: increasing     dir: [0,0]     system: true-    display:-      invisible: true     inventory:     - [1, OK]     devices:@@ -83,8 +79,6 @@   - name: count     dir: [0,0]     system: true-    display:-      invisible: true     inventory:     - [1, two]     - [0, three]

@@ -29,8 +29,6 @@       - [0, lambda]   - name: portkey1     system: true-    display:-      invisible: true     loc: [0,0]     dir: [0,0]     program: |@@ -44,8 +42,6 @@       );   - name: portkey2     system: true-    display:-      invisible: true     loc: [16,0]     dir: [0,0]     program: |

@@ -37,9 +37,12 @@   log "Hi!";   require "branch predictor";   repeat (-    turn east; m2; x <- until (ishere "bit (0)") {harvest}; turn back; m2; place x+    log "I am going for a bit";+    turn east; m2; x <- until (ishere "bit (0)") {harvest}; turn back; m2; place x;+		log "I brought a bit"; )}; until (ishere "bit (0)") {grab}; until (ishere "bit (0)") {grab}; +make "bit (1)"; make "drill bit"

@@ -1,14 +1,15 @@ version: 1 name: Test lodestone description: Pick or drill lodestone and use it to flip bits.-goal:-    - To create a drill bit, you will need to flip the available bit.-win: |-  try {-    as base {has "drill bit"};-  } { return false }+objectives:+  - goal:+        - To create a drill bit, you will need to flip the available bit.+    condition: |+      try {+        as base {has "drill bit"};+      } { return false } solution: |-  run "562-lodestone.sw"+  run "scenarios/Testing/562-lodestone.sw" robots:   - name: base     dir: [1,0]

@@ -23,7 +23,10 @@         idea.       - To prepare you, this simulator will walk you through a series of hands-on         exercises that introduce you to the way robots work and the programming-        language you will use to control them.+        language you will use to control them.  Note that your progress through+        the tutorials will be saved automatically.  You can return to+        the menu at any time to jump around between tutorials or pick+        up again where you left off.       - |         When you're ready for your first challenge, close this dialog with Esc or Ctrl-G,         and type at the prompt:

@@ -20,7 +20,8 @@         TIP: You can use the name of the flower directly ("pickerelweed"),         or you can use bind notation: `f <- harvest; ... ; place f;`.       - |-        TIP: Newly built robots always start out facing north.+        TIP: Newly built robots start out facing the same+        direction as their parent, which in the tutorials will always be north.     condition: |       try {         teleport self (0,-1);

@@ -60,6 +60,6 @@ iterate allOK (foreachF 1 16 $ tryGive   $ "Send a robot to `salvage` me and come back to `give base \"Win\"`.\n"   ++ "When the rescue robot stands where I am and executes `salvage`,\n"-  ++ "all my inventory and logs will go to it, namely the \"Win\".\n"+  ++ "all my inventory and logs will go to it, including the \"Win\".\n"   ++ "Once you have brought the \"Win\" to your base, you will win!" )

@@ -9,17 +9,17 @@       - |         In this challenge, you should start by         sending a robot to walk four steps straight east into the mountain,-        crashing deliberately.  However, you must (1) make sure it has a `logger`,-        so we can see what command failed,-        and (2) use the bind syntax `r <- build {COMMANDS}` so you can refer to-        the newly built robot later.  All together, it might look something like-        this:+        crashing deliberately.  However, you must make sure it has a `logger`,+        so we can see what command failed.  The simplest way to ensure+        that is to have it execute the `log` command; `build` will+        ensure it has the devices it needs to execute its commands.+        For example:       - |-        r <- build {log "Hi!"; turn east; move; move; move; log "3"; move; log "OK"}-      - (`build` will make sure the robot has a `logger` since its program includes-        calls to the `log` command.)-      - After the robot crashes, execute `view r` to see how far it got.-        Further instructions should appear in the crashed robot's log.+        build {log "Hi!"; turn east; move; move; move; log "3"; move; log "OK"}+      - After the robot crashes, execute `view it0` (or whichever+        `itN` variable corresponds to the result of the `build`+        command) to see how far it got. Further instructions should+        appear in the crashed robot's log.     condition: |       try {         as base {has "Win"}

@@ -7,9 +7,10 @@       - Previously you learned how to make new things (like a branch predictor) from ingredients.         Now you will learn how to obtain the ingredients you need.       - There are some trees ahead of your robot; `move` to each one and `grab` it.-      - You can learn more by reading about the grabber device in your inventory.-      - |-        TIP: You can use the arrow key Up ('↑') to reuse your previous commands.+      - You can learn more by reading about the grabber device in your+        inventory.  Remember, if the description does not fit in the+        lower left info box, you can either hit `Enter` to pop out the+        description, or focus the info box in order to scroll.     condition: |       try {         t <- as base {count "tree"};

@@ -32,9 +32,14 @@   - goal:       - Well done! In addition to `move`, you can use the `turn` command         to turn your robot, for example, `turn right` or `turn east`.-      - Switch to the inventory view (by clicking on it, or typing `Alt+E`)-        and select the treads device to read about the details.-        You can come back to the REPL prompt by clicking on it or typing `Alt+R`.+      - Switch to the inventory view in the upper left (by clicking on it or typing `Alt+E`)+        and select the `treads` device to read about the details.+        If the bottom-left info panel is not big enough to read the+        whole thing, you can hit `Enter` on the `treads` device to pop+        out the description, or you can focus the info panel (with+        `Alt+T` or by clicking) and scroll it with arrow keys or PgUp/PgDown.+        When you're done reading, you can come back to the REPL prompt+        by clicking on it or typing `Alt+R`.       - Afterwards, move your robot to the coordinates (8,4) in the northeast corner         marked with two flowers.       - |@@ -149,8 +154,6 @@   - name: check1     loc: [2,0]     system: true-    display:-      invisible: true     program: |       def until = \c. b <- c; if b {} {until c} end;       l <- whereami;@@ -164,8 +167,6 @@   - name: check2     loc: [8,0]     system: true-    display:-      invisible: true     program: |       def until = \c. b <- c; if b {} {until c} end;       l <- whereami;@@ -179,8 +180,6 @@   - name: check3     loc: [8,4]     system: true-    display:-      invisible: true     program: |       def until = \c. b <- c; if b {} {until c} end;       l <- whereami;@@ -194,8 +193,6 @@   - name: check4     loc: [8,8]     system: true-    display:-      invisible: true     program: |       def until = \c. b <- c; if b {} {until c} end;       l <- whereami;@@ -211,36 +208,24 @@   #################   - name: 1P horizontal wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2P horizontal wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3P horizontal wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #################   ## VERTICAL    ##   #################   - name: 1P vertical wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2P vertical wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3P vertical wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #################   ## CORNERS     ##@@ -257,72 +242,48 @@   #########   - name: 1P lower left corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2P lower left corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3P lower left corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #########   ##  B  ##   #########   - name: 1P lower right corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2P lower right corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3P lower right corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #########   ##  C  ##   #########   - name: 1P upper right corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2P upper right corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3P upper right corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #########   ##  D  ##   #########   - name: 1P upper left corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2P upper left corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3P upper left corner     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #################   ## SEPARATORS  ##@@ -330,43 +291,29 @@   # 1   - name: 1S down and horizontal wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 1S up and horizontal wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   # 2   - name: 2S left and vertical wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2S up and horizontal wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   # 3   - name: 3S left and vertical wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3S down and horizontal wall     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #################   ## GATES       ##   #################   - name: 1G     system: true-    display:-      invisible: true     program: |       def until = \c. b <- c; if b {} {until c} end;       c1 <- robotNamed "check1";@@ -374,31 +321,21 @@       grab   - name: 2G     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3G     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   #################   ## GARDENERS   ##   #################   - name: 1P flower     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 2P flower     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw"   - name: 3P flower     system: true-    display:-      invisible: true     program: run "scenarios/Tutorials/move_system.sw" entities:   - name: Win

@@ -34,15 +34,13 @@         ifC (has "tree") {return false} {return true}       } { return false } solution: |-  def m4 = move; move; move; move end;+  def x4 = \c. c;c;c;c end;   def mp = move; place "rock" end;-  def mp4 = mp; mp; mp; mp end;-  def rr = move; turn right; mp4; turn back; m4; turn right end;+  def rr = turn right; move; turn right; x4 mp; turn back; x4 move end;   build {-    require "treads"; require "grabber"; // #540+    require "treads"; require "grabber"; require "lambda"; // #540     require 16 "rock";-    turn right;-    rr; rr; rr; rr+    x4 rr   }; robots:   - name: base@@ -62,6 +60,7 @@       - [16, treads]       - [16, grabber]       - [16, scanner]+      - [16, lambda]       - [100, rock] world:   default: [blank]

@@ -30,7 +30,7 @@   } robots:   - name: base-    dir: [1,0]+    dir: [0,1]     heavy: true     display:       char: Ω

@@ -8,8 +8,7 @@         every expression in the language has a type, and all the types must match up         properly before a program can be executed.       - To see the type of an expression, enter the expression at the-        REPL prompt without hitting Return.  If the expression type-        checks,+        REPL prompt (you do not need to execute it).  If the expression type checks,         its type will be displayed in gray text at the top right of the window.       - For example, if you try typing `move`, you can see that it has         type `cmd unit`, which means that `move` is a command which

@@ -100,7 +100,7 @@                "west"                "down"              ))-             (x-types '("int" "text" "dir" "bool" "cmd"))+             (x-types '("int" "text" "dir" "bool" "cmd" "void" "unit"))               (x-keywords-regexp (regexp-opt x-keywords 'words))              (x-builtins-regexp (regexp-opt x-builtins 'words))

@@ -16,9 +16,8 @@ 				"begin": "def\\s+(\\w+)\\s*(:((\\s*(cmd|dir|string|int|\\(|\\)|\\{|\\}|(\\*|\\+|->)|[a-z]\\w*|forall ([a-z]\\w*\\s*)+.)\\s*)+))?=", 				"end": "end", 				"beginCaptures": {-					"1": {"name": "variable.other"},-					"3": {"name": "storage.type"},-					"5": {"name": "storage.modifier"}+					"1": {"name": "entity.name.function"},+					"3": {"name": "entity.name.type"} 				}, 				"patterns": [ 					{"include": "#keywords"},@@ -30,12 +29,11 @@ 				}, 				{ 				"name": "keyword.control.dictionary.let",-				"begin": "\\s*let\\s+(\\w+)\\s*(:((\\s*(cmd|dir|string|int|\\(|\\)|\\{|\\}|(\\*|\\+|->)|[a-z]\\w*|forall ([a-z]\\w*\\s*)+.)\\s*)+))?=",+				"begin": "\\s*let\\s+(\\w+)\\s*(:((\\s*(cmd|dir|text|int|void|unit|\\(|\\)|\\{|\\}|(\\*|\\+|->)|[a-z]\\w*|forall ([a-z]\\w*\\s*)+.)\\s*)+))?=", 				"end": "\\s*in", 				"beginCaptures": {-					"1": {"name": "variable.other"},-					"3": {"name": "storage.type"},-					"5": {"name": "storage.modifier"}+					"1": {"name": "entity.name.function"},+					"3": {"name": "entity.name.type"} 				}, 				"patterns": [ 					{"include": "#keywords"},@@ -94,7 +92,7 @@ 				"match": "\\b(?i)(left|right|back|forward|north|south|east|west|down)\\b" 				}, 				{-				"name": "variable.other"	,+				"name": "variable.parameter", 				"match": "\\b(?i)([a-z]\\w*)\\b" 				} 			]

@@ -70,7 +70,7 @@           writeBChan chan Frame        _ <- forkIO $ do-        upRel <- getNewerReleaseVersion+        upRel <- getNewerReleaseVersion (repoGitInfo opts)         writeBChan chan (UpstreamVersion upRel)        -- Start the web service with a reference to the game state@@ -108,9 +108,11 @@         AppOpts           { userSeed = Nothing           , userScenario = demoScenario-          , toRun = Nothing+          , scriptToRun = Nothing+          , autoPlay = False           , cheatMode = False           , userWebPort = Nothing+          , repoGitInfo = Nothing           }   case res of     Left errMsg -> T.putStrLn errMsg

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  module Swarm.DocGen (   generateDocs,@@ -14,39 +15,49 @@   editorList,    -- ** Wiki pages+  PageAddress (..),   commandsPage,+  capabilityPage,+  noPageAddresses, ) where +import Control.Arrow (left) import Control.Lens (view, (^.))+import Control.Lens.Combinators (to) import Control.Monad (zipWithM, zipWithM_, (<=<))-import Control.Monad.Except (ExceptT, runExceptT)+import Control.Monad.Except (ExceptT, liftIO, runExceptT) import Data.Bifunctor (Bifunctor (bimap)) import Data.Containers.ListUtils (nubOrd)-import Data.Foldable (toList)+import Data.Foldable (find, toList) import Data.List (transpose) import Data.Map.Lazy (Map) import Data.Map.Lazy qualified as Map-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isJust) import Data.Set (Set) import Data.Set qualified as Set import Data.Text (Text, unpack) import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Tuple (swap)-import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityName, loadEntities)+import Data.Yaml (decodeFileEither)+import Data.Yaml.Aeson (prettyPrintParseException)+import Swarm.Game.Display (displayChar)+import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities) import Swarm.Game.Entity qualified as E-import Swarm.Game.Recipe (Recipe, loadRecipes, recipeInputs, recipeOutputs, recipeRequirements)+import Swarm.Game.Recipe (Recipe, loadRecipes, recipeInputs, recipeOutputs, recipeRequirements, recipeTime, recipeWeight) import Swarm.Game.Robot (installedDevices, instantiateRobot, robotInventory) import Swarm.Game.Scenario (Scenario, loadScenario, scenarioRobots) import Swarm.Game.WorldGen (testWorld2Entites)-import Swarm.Language.Capability (capabilityName, constCaps)+import Swarm.Language.Capability (Capability)+import Swarm.Language.Capability qualified as Capability import Swarm.Language.Pretty (prettyText) import Swarm.Language.Syntax (Const (..)) import Swarm.Language.Syntax qualified as Syntax import Swarm.Language.Typecheck (inferConst)-import Swarm.Util (isRightOr)+import Swarm.Util (getDataFileNameSafe, isRightOr) import Text.Dot (Dot, NodeId, (.->.)) import Text.Dot qualified as Dot+import Witch (from)  -- ============================================================================ -- MAIN ENTRYPOINT TO CLI DOCUMENTATION GENERATOR@@ -61,7 +72,7 @@   RecipeGraph :: GenerateDocs   -- | Keyword lists for editors.   EditorKeywords :: Maybe EditorType -> GenerateDocs-  CheatSheet :: Maybe SheetType -> GenerateDocs+  CheatSheet :: PageAddress -> Maybe SheetType -> GenerateDocs   deriving (Eq, Show)  data EditorType = Emacs | VSCode@@ -70,6 +81,17 @@ data SheetType = Entities | Commands | Capabilities | Recipes   deriving (Eq, Show, Enum, Bounded) +data PageAddress = PageAddress+  { entityAddress :: Text+  , commandsAddress :: Text+  , capabilityAddress :: Text+  , recipesAddress :: Text+  }+  deriving (Eq, Show)++noPageAddresses :: PageAddress+noPageAddresses = PageAddress "" "" "" ""+ generateDocs :: GenerateDocs -> IO () generateDocs = \case   RecipeGraph -> generateRecipe >>= putStrLn@@ -84,11 +106,23 @@               putStrLn $ replicate 40 '-'               generateEditorKeywords et         mapM_ editorGen [minBound .. maxBound]-  CheatSheet s -> case s of-    Nothing -> error "Not implemented"+  CheatSheet address s -> case s of+    Nothing -> error "Not implemented for all Wikis"     Just st -> case st of       Commands -> T.putStrLn commandsPage-      _ -> error "Not implemented"+      Capabilities -> simpleErrorHandle $ do+        entities <- loadEntities >>= guardRight "load entities"+        liftIO $ T.putStrLn $ capabilityPage address entities+      Entities -> simpleErrorHandle $ do+        let loadEntityList fp = left (from . prettyPrintParseException) <$> decodeFileEither fp+        let f = "entities.yaml"+        Just fileName <- liftIO $ getDataFileNameSafe f+        entities <- liftIO (loadEntityList fileName) >>= guardRight "load entities"+        liftIO $ T.putStrLn $ entitiesPage address entities+      Recipes -> simpleErrorHandle $ do+        entities <- loadEntities >>= guardRight "load entities"+        recipes <- loadRecipes entities >>= guardRight "load recipes"+        liftIO $ T.putStrLn $ recipePage address recipes  -- ---------------------------------------------------------------------------- -- GENERATE KEYWORDS: LIST OF WORDS TO BE HIGHLIGHTED@@ -175,6 +209,12 @@ maxWidths :: [[Text]] -> [Int] maxWidths = map (maximum . map T.length) . transpose +addLink :: Text -> Text -> Text+addLink l t = T.concat ["[", t, "](", l, ")"]++tshow :: Show a => a -> Text+tshow = T.pack . show+ -- --------- -- COMMANDS -- ---------@@ -186,13 +226,11 @@ commandToList c =   map     escapeTable-    [ addLink (T.pack $ "#" <> show c) . codeQuote $ constSyntax c+    [ addLink ("#" <> tshow c) . codeQuote $ constSyntax c     , codeQuote . prettyText $ inferConst c-    , maybe "" capabilityName $ constCaps c+    , maybe "" Capability.capabilityName $ Capability.constCaps c     , Syntax.briefDoc . Syntax.constDoc $ Syntax.constInfo c     ]- where-  addLink l t = T.concat ["[", t, "](", l, ")"]  constTable :: [Const] -> Text constTable cs = T.unlines $ header <> map (listToRow mw) commandRows@@ -208,7 +246,7 @@     , ""     , "- syntax: " <> codeQuote (constSyntax c)     , "- type: " <> (codeQuote . prettyText $ inferConst c)-    , maybe "" (("- required capabilities: " <>) . capabilityName) $ constCaps c+    , maybe "" (("- required capabilities: " <>) . Capability.capabilityName) $ Capability.constCaps c     , ""     , Syntax.briefDoc . Syntax.constDoc $ Syntax.constInfo c     ]@@ -228,6 +266,136 @@     , "# Detailed descriptions"     ]       <> map commandToSection (commands <> builtinFunctions <> operators)++-- -------------+-- CAPABILITIES+-- -------------++capabilityHeader :: [Text]+capabilityHeader = ["Name", "Commands", "Entities"]++capabilityRow :: PageAddress -> EntityMap -> Capability -> [Text]+capabilityRow PageAddress {..} em cap =+  map+    escapeTable+    [ Capability.capabilityName cap+    , T.intercalate ", " (linkCommand <$> cs)+    , T.intercalate ", " (linkEntity . view entityName <$> es)+    ]+ where+  linkEntity t =+    if T.null entityAddress+      then t+      else addLink (entityAddress <> "#" <> T.replace " " "-" t) t+  linkCommand c =+    ( if T.null commandsAddress+        then id+        else addLink (commandsAddress <> "#" <> tshow c)+    )+      . codeQuote+      $ constSyntax c++  cs = [c | c <- Syntax.allConst, let mcap = Capability.constCaps c, isJust $ find (== cap) mcap]+  es = fromMaybe [] $ E.entitiesByCap em Map.!? cap++capabilityTable :: PageAddress -> EntityMap -> [Capability] -> Text+capabilityTable a em cs = T.unlines $ header <> map (listToRow mw) capabilityRows+ where+  mw = maxWidths (capabilityHeader : capabilityRows)+  capabilityRows = map (capabilityRow a em) cs+  header = [listToRow mw capabilityHeader, separatingLine mw]++capabilityPage :: PageAddress -> EntityMap -> Text+capabilityPage a em = capabilityTable a em [minBound .. maxBound]++-- ---------+-- Entities+-- ---------++entityHeader :: [Text]+entityHeader = ["?", "Name", "Capabilities", "Properties*", "Portable"]++entityToList :: Entity -> [Text]+entityToList e =+  map+    escapeTable+    [ codeQuote . T.singleton $ e ^. entityDisplay . to displayChar+    , addLink ("#" <> linkID) $ view entityName e+    , T.intercalate ", " $ Capability.capabilityName <$> view E.entityCapabilities e+    , T.intercalate ", " . map tshow . filter (/= E.Portable) $ toList props+    , if E.Portable `elem` props+        then ":heavy_check_mark:"+        else ":negative_squared_cross_mark:"+    ]+ where+  props = view E.entityProperties e+  linkID = T.replace " " "-" $ view entityName e++entityTable :: [Entity] -> Text+entityTable es = T.unlines $ header <> map (listToRow mw) entityRows+ where+  mw = maxWidths (entityHeader : entityRows)+  entityRows = map entityToList es+  header = [listToRow mw entityHeader, separatingLine mw]++entityToSection :: Entity -> Text+entityToSection e =+  T.unlines $+    [ "## " <> view E.entityName e+    , ""+    , " - Char: " <> (codeQuote . T.singleton $ e ^. entityDisplay . to displayChar)+    ]+      <> [" - Properties: " <> T.intercalate ", " (map tshow $ toList props) | not $ null props]+      <> [" - Capabilities: " <> T.intercalate ", " (Capability.capabilityName <$> caps) | not $ null caps]+      <> ["\n"]+      <> [T.intercalate "\n\n" $ view E.entityDescription e]+ where+  props = view E.entityProperties e+  caps = view E.entityCapabilities e++entitiesPage :: PageAddress -> [Entity] -> Text+entitiesPage _a es =+  T.intercalate "\n\n" $+    [ "# Entities"+    , "This is a quick-overview table of entities - click the name for detailed description."+    , "*) As a note, most entities have the Portable property, so we show it in a separate column."+    , entityTable es+    ]+      <> map entityToSection es++-- -------------+-- RECIPES+-- -------------++recipeHeader :: [Text]+recipeHeader = ["In", "Out", "Required", "Time", "Weight"]++recipeRow :: PageAddress -> Recipe Entity -> [Text]+recipeRow PageAddress {..} r =+  map+    escapeTable+    [ T.intercalate ", " (map formatCE $ view recipeInputs r)+    , T.intercalate ", " (map formatCE $ view recipeOutputs r)+    , T.intercalate ", " (map formatCE $ view recipeRequirements r)+    , tshow $ view recipeTime r+    , tshow $ view recipeWeight r+    ]+ where+  formatCE (c, e) = T.unwords [tshow c, linkEntity $ view entityName e]+  linkEntity t =+    if T.null entityAddress+      then t+      else addLink (entityAddress <> "#" <> T.replace " " "-" t) t++recipeTable :: PageAddress -> [Recipe Entity] -> Text+recipeTable a rs = T.unlines $ header <> map (listToRow mw) recipeRows+ where+  mw = maxWidths (recipeHeader : recipeRows)+  recipeRows = map (recipeRow a) rs+  header = [listToRow mw recipeHeader, separatingLine mw]++recipePage :: PageAddress -> [Recipe Entity] -> Text+recipePage = recipeTable  -- ---------------------------------------------------------------------------- -- GENERATE GRAPHVIZ: ENTITY DEPENDENCIES BY RECIPES

@@ -41,11 +41,13 @@ import Data.Hashable (Hashable) import Data.Map (Map) import Data.Map qualified as M+import Data.Maybe (fromMaybe, isJust) import Data.Yaml import GHC.Generics (Generic) import Swarm.Language.Syntax (Direction (..)) import Swarm.TUI.Attr (entityAttr, robotAttr, worldPrefix) import Swarm.Util (maxOn, (?))+import Swarm.Util.Yaml (FromJSONE (..), With (runE), getE, liftE, withObjectE)  -- | Display priority.  Entities with higher priority will be drawn on --   top of entities with lower priority.@@ -98,14 +100,21 @@ invisible :: Lens' Display Bool  instance FromJSON Display where-  parseJSON = withObject "Display" $ \v ->-    Display-      <$> v .:? "char" .!= ' '-      <*> v .:? "orientationMap" .!= M.empty-      <*> v .:? "curOrientation"-      <*> (fmap (worldPrefix <>) <$> v .:? "attr") .!= entityAttr-      <*> v .:? "priority" .!= 1-      <*> v .:? "invisible" .!= False+  parseJSON v = runE (parseJSONE v) (defaultEntityDisplay ' ')++instance FromJSONE Display Display where+  parseJSONE = withObjectE "Display" $ \v -> do+    defD <- getE+    mc <- liftE $ v .:? "char"+    let c = fromMaybe (defD ^. defaultChar) mc+    let dOM = if isJust mc then mempty else defD ^. orientationMap+    liftE $+      Display c+        <$> v .:? "orientationMap" .!= dOM+        <*> v .:? "curOrientation" .!= (defD ^. curOrientation)+        <*> (fmap (worldPrefix <>) <$> v .:? "attr") .!= (defD ^. displayAttr)+        <*> v .:? "priority" .!= (defD ^. displayPriority)+        <*> v .:? "invisible" .!= (defD ^. invisible)  instance ToJSON Display where   toJSON d =

@@ -97,6 +97,7 @@ import Data.Map qualified as M import Data.Maybe (fromMaybe, isJust, listToMaybe) import Data.Set (Set)+import Data.Set qualified as Set (fromList) import Data.Set.Lens (setOf) import Data.Text (Text) import Data.Text qualified as T@@ -219,7 +220,7 @@     -- grabbed.     _entityYields :: Maybe Text   , -- | Properties of the entity.-    _entityProperties :: [EntityProperty]+    _entityProperties :: Set EntityProperty   , -- | Capabilities provided by this entity.     _entityCapabilities :: [Capability]   , -- | Inventory of other entities held by this entity.@@ -274,7 +275,7 @@   [Capability] ->   Entity mkEntity disp nm descr props caps =-  rehashEntity $ Entity 0 disp nm Nothing descr Nothing Nothing Nothing props caps empty+  rehashEntity $ Entity 0 disp nm Nothing descr Nothing Nothing Nothing (Set.fromList props) caps empty  ------------------------------------------------------------ -- Entity map@@ -330,7 +331,7 @@               <*> v .:? "orientation"               <*> v .:? "growth"               <*> v .:? "yields"-              <*> v .:? "properties" .!= []+              <*> v .:? "properties" .!= mempty               <*> v .:? "capabilities" .!= []               <*> pure empty           )@@ -431,7 +432,7 @@ entityYields = hashedLens _entityYields (\e x -> e {_entityYields = x})  -- | The properties enjoyed by this entity.-entityProperties :: Lens' Entity [EntityProperty]+entityProperties :: Lens' Entity (Set EntityProperty) entityProperties = hashedLens _entityProperties (\e x -> e {_entityProperties = x})  -- | Test whether an entity has a certain property.

@@ -41,6 +41,7 @@   defReqs,   defVals,   defStore,+  emptyRobotContext,    -- ** Lenses   robotEntity,@@ -95,13 +96,14 @@ import GHC.Generics (Generic) import Linear import Swarm.Game.CESK-import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay)+import Swarm.Game.Display (Display, curOrientation, defaultRobotDisplay, invisible) import Swarm.Game.Entity hiding (empty) import Swarm.Game.Value as V import Swarm.Language.Capability (Capability) import Swarm.Language.Context qualified as Ctx import Swarm.Language.Requirement (ReqCtx) import Swarm.Language.Syntax (toDirection)+import Swarm.Language.Typed (Typed (..)) import Swarm.Language.Types (TCtx) import Swarm.Util () import Swarm.Util.Yaml@@ -127,6 +129,31 @@  makeLenses ''RobotContext +emptyRobotContext :: RobotContext+emptyRobotContext = RobotContext Ctx.empty Ctx.empty Ctx.empty emptyStore++type instance Index RobotContext = Ctx.Var+type instance IxValue RobotContext = Typed Value++instance Ixed RobotContext+instance At RobotContext where+  at name = lens getter setter+   where+    getter ctx =+      do+        typ <- Ctx.lookup name (ctx ^. defTypes)+        val <- Ctx.lookup name (ctx ^. defVals)+        req <- Ctx.lookup name (ctx ^. defReqs)+        return $ Typed val typ req+    setter ctx Nothing =+      ctx & defTypes %~ Ctx.delete name+        & defVals %~ Ctx.delete name+        & defReqs %~ Ctx.delete name+    setter ctx (Just (Typed val typ req)) =+      ctx & defTypes %~ Ctx.addBinding name typ+        & defVals %~ Ctx.addBinding name val+        & defReqs %~ Ctx.addBinding name req+ data LogSource = Said | Logged | ErrorTrace   deriving (Show, Eq, Ord, Generic, FromJSON, ToJSON) @@ -472,7 +499,7 @@     , _robotLog = Seq.empty     , _robotLogUpdated = False     , _robotLocation = loc-    , _robotContext = RobotContext Ctx.empty Ctx.empty Ctx.empty emptyStore+    , _robotContext = emptyRobotContext     , _robotID = rid     , _robotParentID = pid     , _robotHeavy = heavy@@ -489,20 +516,23 @@ -- | We can parse a robot from a YAML file if we have access to an --   'EntityMap' in which we can look up the names of entities. instance FromJSONE EntityMap TRobot where-  parseJSONE = withObjectE "robot" $ \v ->+  parseJSONE = withObjectE "robot" $ \v -> do     -- Note we can't generate a unique ID here since we don't have     -- access to a 'State GameState' effect; a unique ID will be     -- filled in later when adding the robot to the world.+    sys <- liftE $ v .:? "system" .!= False+    let defDisplay = defaultRobotDisplay & invisible .~ sys+     mkRobot () Nothing       <$> liftE (v .: "name")       <*> liftE (v .:? "description" .!= [])       <*> liftE (v .:? "loc")       <*> liftE (v .:? "dir" .!= zero)-      <*> liftE (v .:? "display" .!= defaultRobotDisplay)+      <*> localE (const defDisplay) (v ..:? "display" ..!= defDisplay)       <*> liftE (mkMachine <$> (v .:? "program"))       <*> v ..:? "devices" ..!= []       <*> v ..:? "inventory" ..!= []-      <*> liftE (v .:? "system" .!= False)+      <*> pure sys       <*> liftE (v .:? "heavy" .!= False)       <*> pure 0    where

@@ -25,6 +25,7 @@   -- * WorldDescription   Cell (..),   WorldDescription (..),+  IndexedTRobot,    -- * Scenario   Scenario,@@ -52,7 +53,6 @@ ) where  import Control.Algebra (Has)-import Control.Arrow ((&&&)) import Control.Carrier.Lift (Lift, sendIO) import Control.Carrier.Throw.Either (Throw, throwError) import Control.Lens hiding (from, (<.>))@@ -116,13 +116,17 @@ -- Robot map ------------------------------------------------------------ +-- | A robot template paired with its definition's index within+-- the Scenario file+type IndexedTRobot = (Int, TRobot)+ -- | A map from names to robots, used to look up robots in scenario --   descriptions.-type RobotMap = Map Text TRobot+type RobotMap = Map Text IndexedTRobot  -- | Create a 'RobotMap' from a list of robot templates. buildRobotMap :: [TRobot] -> RobotMap-buildRobotMap = M.fromList . map (view trobotName &&& id)+buildRobotMap rs = M.fromList $ zipWith (\x y -> (view trobotName y, (x, y))) [0 ..] rs  ------------------------------------------------------------ -- Lookup utilities@@ -144,7 +148,7 @@  -- | Look up a robot by name in a 'RobotMap', throwing a parse error --   if it is not found.-getRobot :: Text -> ParserE RobotMap TRobot+getRobot :: Text -> ParserE RobotMap IndexedTRobot getRobot = getThing "robot" M.lookup  ------------------------------------------------------------@@ -156,7 +160,7 @@ data Cell = Cell   { cellTerrain :: TerrainType   , cellEntity :: Maybe Entity-  , cellRobots :: [TRobot]+  , cellRobots :: [IndexedTRobot]   }   deriving (Eq, Show) 

@@ -25,6 +25,7 @@   scenarioBestTime,   scenarioBestTicks,   updateScenarioInfoOnQuit,+  ScenarioInfoPair,    -- * Scenario collection   ScenarioCollection (..),@@ -130,6 +131,8 @@   toEncoding = genericToEncoding scenarioOptions   toJSON = genericToJSON scenarioOptions +type ScenarioInfoPair = (Scenario, ScenarioInfo)+ scenarioOptions :: Options scenarioOptions =   defaultOptions@@ -173,12 +176,12 @@  -- | A scenario item is either a specific scenario, or a collection of --   scenarios (*e.g.* the scenarios contained in a subdirectory).-data ScenarioItem = SISingle Scenario ScenarioInfo | SICollection Text ScenarioCollection+data ScenarioItem = SISingle ScenarioInfoPair | SICollection Text ScenarioCollection   deriving (Eq, Show)  -- | Retrieve the name of a scenario item. scenarioItemName :: ScenarioItem -> Text-scenarioItemName (SISingle s _ss) = s ^. scenarioName+scenarioItemName (SISingle (s, _ss)) = s ^. scenarioName scenarioItemName (SICollection name _) = name  -- | A scenario collection is a tree of scenarios, keyed by name,@@ -330,7 +333,7 @@     False -> do       s <- loadScenarioFile em path       si <- loadScenarioInfo path-      return $ SISingle s si+      return $ SISingle (s, si)  ------------------------------------------------------------ -- Some lenses + prisms

@@ -38,6 +38,7 @@   robotsByLocation,   robotsAtLocation,   robotsInArea,+  baseRobot,   activeRobots,   waitingRobots,   availableRecipes,@@ -61,6 +62,7 @@   viewCenter,   needsRedraw,   replStatus,+  replNextValueIndex,   replWorking,   replActiveType,   messageQueue,@@ -79,6 +81,7 @@   scenarioToGameState,   initGameStateForScenario,   classicGame0,+  CodeToRun (..),    -- * Utilities   applyViewCenterRule,@@ -117,7 +120,7 @@ import Data.IntSet (IntSet) import Data.IntSet qualified as IS import Data.IntSet.Lens (setOf)-import Data.List (partition)+import Data.List (partition, sortOn) import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty qualified as NE import Data.Map (Map)@@ -153,6 +156,7 @@ import Swarm.Language.Pipeline (ProcessedTerm) import Swarm.Language.Pipeline.QQ (tmQ) import Swarm.Language.Syntax (Const, Term (TText), allConst)+import Swarm.Language.Typed (Typed (Typed)) import Swarm.Language.Types import Swarm.Util (getDataFileNameSafe, getElemsInArea, isRightOr, manhattan, uniq, (<+=), (<<.=), (?)) import System.Clock qualified as Clock@@ -163,6 +167,10 @@ -- Subsidiary data types ------------------------------------------------------------ +data CodeToRun+  = SuggestedSolution ProcessedTerm+  | ScriptPath FilePath+ -- | The 'ViewCenterRule' specifies how to determine the center of the --   world viewport. data ViewCenterRule@@ -178,12 +186,12 @@ data REPLStatus   = -- | The REPL is not doing anything actively at the moment.     --   We persist the last value and its type though.-    REPLDone (Maybe (Polytype, Value))+    REPLDone (Maybe (Typed Value))   | -- | A command entered at the REPL is currently being run.  The     --   'Polytype' represents the type of the expression that was     --   entered.  The @Maybe Value@ starts out as @Nothing@ and gets     --   filled in with a result once the command completes.-    REPLWorking Polytype (Maybe Value)+    REPLWorking (Typed (Maybe Value))   deriving (Eq, Show, Generic, FromJSON, ToJSON)  data WinCondition@@ -285,6 +293,7 @@   , _viewCenter :: V2 Int64   , _needsRedraw :: Bool   , _replStatus :: REPLStatus+  , _replNextValueIndex :: Integer   , _messageQueue :: Seq LogEntry   , _lastSeenMessageTime :: Integer   , _focusedRobotID :: RID@@ -361,6 +370,10 @@   rl = gs ^. robotsByLocation   rids = concatMap IS.elems $ getElemsInArea o d rl +-- | The base robot, if it exists.+baseRobot :: Traversal' GameState Robot+baseRobot = robotMap . ix 0+ -- | The list of entities that have been discovered. allDiscoveredEntities :: Lens' GameState Inventory @@ -442,6 +455,9 @@ -- | The current status of the REPL. replStatus :: Lens' GameState REPLStatus +-- | The index of the next it{index} value+replNextValueIndex :: Lens' GameState Integer+ -- | A queue of global messages. -- -- Note that we put the newest entry to the right.@@ -499,14 +515,14 @@ replWorking = to (\s -> matchesWorking $ s ^. replStatus)  where   matchesWorking (REPLDone _) = False-  matchesWorking (REPLWorking _ _) = True+  matchesWorking (REPLWorking _) = True  -- | Either the type of the command being executed, or of the last command replActiveType :: Getter REPLStatus (Maybe Polytype) replActiveType = to getter  where-  getter (REPLDone (Just (typ, _))) = Just typ-  getter (REPLWorking typ _) = Just typ+  getter (REPLDone (Just (Typed _ typ _))) = Just typ+  getter (REPLWorking (Typed _ typ _)) = Just typ   getter _ = Nothing  -- | Get the notification list of messages from the point of view of focused robot.@@ -714,6 +730,7 @@       , _viewCenter = V2 0 0       , _needsRedraw = False       , _replStatus = REPLDone Nothing+      , _replNextValueIndex = 0       , _messageQueue = Empty       , _lastSeenMessageTime = -1       , _focusedRobotID = 0@@ -722,7 +739,7 @@       }  -- | Set a given scenario as the currently loaded scenario in the game state.-scenarioToGameState :: Scenario -> Maybe Seed -> Maybe String -> GameState -> IO GameState+scenarioToGameState :: Scenario -> Maybe Seed -> Maybe CodeToRun -> GameState -> IO GameState scenarioToGameState scenario userSeed toRun g = do   -- Decide on a seed.  In order of preference, we will use:   --   1. seed value provided by the user@@ -764,7 +781,8 @@         -- otherwise the store of definition cells is not saved (see #333)         _replStatus = case toRun of           Nothing -> REPLDone Nothing-          Just _ -> REPLWorking PolyUnit Nothing+          Just _ -> REPLWorking (Typed Nothing PolyUnit mempty)+      , _replNextValueIndex = 0       , _messageQueue = Empty       , _focusedRobotID = baseID       , _ticks = 0@@ -779,14 +797,42 @@   -- the others existed only to serve as a template for robots drawn   -- in the world map   locatedRobots = filter (isJust . view trobotLocation) $ scenario ^. scenarioRobots+  getCodeToRun x = case x of+    SuggestedSolution s -> s+    ScriptPath (into @Text -> f) -> [tmQ| run($str:f) |]++  -- Rules for selecting the "base" robot:+  -- -------------------------------------+  -- What follows is a thorough description of how the base+  -- choice is made as of the most recent study of the code.+  -- This level of detail is not meant to be public-facing.+  --+  -- For an abbreviated explanation, see the "Base robot" section of the+  -- "Scenario Authoring Guide".+  -- https://github.com/swarm-game/swarm/tree/main/data/scenarios#base-robot+  --+  -- Precedence rules:+  -- 1. Prefer those robots defined with a loc in the Scenario file+  --   1.a. If multiple robots define a loc, use the robot that is defined+  --        first within the Scenario file.+  --   1.b. Note that if a robot is both given a loc AND is specified in the+  --        world map, then two instances of the robot shall be created. The+  --        instance with the loc shall be preferred as the base.+  -- 2. Fall back to robots generated from templates via the map and palette.+  --   2.a. If multiple robots are specified in the map, prefer the one that+  --        is defined first within the Scenario file.+  --   2.b. If multiple robots are instantiated from the same template, then+  --        prefer the one closest to the upper-left of the screen, with higher rows given precedence over columns.+  robotsByBasePrecedence = locatedRobots ++ map snd (sortOn fst genRobots)+   robotList =-    zipWith instantiateRobot [baseID ..] (locatedRobots ++ genRobots)+    zipWith instantiateRobot [baseID ..] robotsByBasePrecedence       -- If the  --run flag was used, use it to replace the CESK machine of the       -- robot whose id is 0, i.e. the first robot listed in the scenario.       & ix baseID . machine-        %~ case toRun of+        %~ case getCodeToRun <$> toRun of           Nothing -> id-          Just (into @Text -> f) -> const (initMachine [tmQ| run($str:f) |] Ctx.empty emptyStore)+          Just pt -> const $ initMachine pt Ctx.empty emptyStore       -- If we are in creative mode, give base all the things       & ix baseID . robotInventory         %~ case scenario ^. scenarioCreative of@@ -817,7 +863,7 @@  -- | Take a world description, parsed from a scenario file, and turn --   it into a list of located robots and a world function.-buildWorld :: EntityMap -> WorldDescription -> ([TRobot], Seed -> WorldFun Int Entity)+buildWorld :: EntityMap -> WorldDescription -> ([IndexedTRobot], Seed -> WorldFun Int Entity) buildWorld em WorldDescription {..} = (robots, first fromEnum . wf)  where   rs = fromIntegral $ length area@@ -836,7 +882,7 @@     Just (Cell t e _) -> const (worldFunFromArray worldArray (t, e))    -- Get all the robots described in cells and set their locations appropriately-  robots :: [TRobot]+  robots :: [IndexedTRobot]   robots =     area       & traversed Control.Lens.<.> traversed %@~ (,) -- add (r,c) indices@@ -844,15 +890,18 @@       & concatMap         ( \((fromIntegral -> r, fromIntegral -> c), Cell _ _ robotList) ->             let robotWithLoc = trobotLocation ?~ W.coordsToLoc (Coords (ulr + r, ulc + c))-             in map robotWithLoc robotList+             in map (fmap robotWithLoc) robotList         )  -- | Create an initial game state for a specific scenario.-initGameStateForScenario :: String -> Maybe Seed -> Maybe String -> ExceptT Text IO GameState+-- Note that this function is used only for unit tests, integration tests, and benchmarks.+--+-- In normal play, the code path that gets executed is scenarioToAppState.+initGameStateForScenario :: String -> Maybe Seed -> Maybe FilePath -> ExceptT Text IO GameState initGameStateForScenario sceneName userSeed toRun = do   g <- initGameState   (scene, path) <- loadScenario sceneName (g ^. entityMap)-  gs <- liftIO $ scenarioToGameState scene userSeed toRun g+  gs <- liftIO $ scenarioToGameState scene userSeed (ScriptPath <$> toRun) g   normalPath <- liftIO $ normalizeScenarioPath (gs ^. scenarios) path   t <- liftIO getZonedTime   return $@@ -862,5 +911,6 @@  -- | For convenience, the 'GameState' corresponding to the classic --   game with seed 0.+--   This is used only for benchmarks and unit tests. classicGame0 :: ExceptT Text IO GameState classicGame0 = initGameStateForScenario "classic" (Just 0) Nothing

@@ -17,6 +17,7 @@ -- interpreter for the Swarm language. module Swarm.Game.Step where +import Control.Applicative (liftA2) import Control.Carrier.Error.Either (runError) import Control.Carrier.State.Lazy import Control.Carrier.Throw.Either (ThrowC, runThrow)@@ -65,6 +66,7 @@ import Swarm.Language.Pipeline.QQ (tmQ) import Swarm.Language.Requirement qualified as R import Swarm.Language.Syntax+import Swarm.Language.Typed (Typed (..)) import Swarm.Util import System.Clock (TimeSpec) import System.Clock qualified@@ -110,10 +112,10 @@     Just r -> do       res <- use replStatus       case res of-        REPLWorking ty Nothing -> case getResult r of+        REPLWorking (Typed Nothing ty req) -> case getResult r of           Just (v, s) -> do-            replStatus .= REPLWorking ty (Just v)-            robotMap . ix 0 . robotContext . defStore .= s+            replStatus .= REPLWorking (Typed (Just v) ty req)+            baseRobot . robotContext . defStore .= s           Nothing -> return ()         _otherREPLStatus -> return ()     Nothing -> return ()@@ -1103,14 +1105,16 @@     Listen -> do       gs <- get @GameState       loc <- use robotLocation+      rid <- use robotID       creative <- use creativeMode       system <- use systemRobot       mq <- use messageQueue-      let recentAndClose e = system || creative || messageIsRecent gs e && messageIsFromNearby loc e-          limitLast = \case+      let isClose e = system || creative || messageIsFromNearby loc e+      let notMine e = rid /= e ^. leRobotID+      let limitLast = \case             _s Seq.:|> l -> Just $ l ^. leText             _ -> Nothing-          mm = limitLast $ Seq.takeWhileR recentAndClose mq+      let mm = limitLast . Seq.filter (liftA2 (&&) notMine isClose) $ Seq.takeWhileR (messageIsRecent gs) mq       return $         maybe           (In (TConst Listen) mempty s (FExec : k)) -- continue listening@@ -1344,7 +1348,7 @@               ["A robot built by the robot named " <> r ^. robotName <> "."]               (Just (r ^. robotLocation))               ( ((r ^. robotOrientation) >>= \dir -> guard (dir /= zero) >> return dir)-                  ? east+                  ? north               )               defaultRobotDisplay               (In cmd e s [FExec])

@@ -75,11 +75,11 @@  -- | Convert an (x,y) location to a 'Coords' value. locToCoords :: V2 Int64 -> Coords-locToCoords (V2 x y) = Coords (- y, x)+locToCoords (V2 x y) = Coords (-y, x)  -- | Convert 'Coords' to an (x,y) location. coordsToLoc :: Coords -> V2 Int64-coordsToLoc (Coords (r, c)) = V2 c (- r)+coordsToLoc (Coords (r, c)) = V2 c (-r)  ------------------------------------------------------------ -- World function

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeApplications #-}  -- | -- Module      :  Swarm.Game.WorldGen@@ -14,12 +15,14 @@ import Data.Array.IArray import Data.Bifunctor (second) import Data.Bool+import Data.ByteString (ByteString) import Data.Enumeration import Data.Hash.Murmur import Data.Int (Int64) import Data.List (find) import Data.Maybe (fromMaybe, mapMaybe) import Data.Set qualified as S+import Data.Tagged import Data.Text (Text) import Data.Text qualified as T import Numeric.Noise.Perlin@@ -27,6 +30,7 @@ import Swarm.Game.Terrain import Swarm.Game.World import Witch+import Witch.Encoding qualified as Encoding  -- | A simple test world used for a while during early development. testWorld1 :: Coords -> (TerrainType, Maybe Text)@@ -92,7 +96,7 @@       (bool Soft Hard (sample ix pn1 > 0))       (bool Natural Artificial (sample ix pn2 > 0))    where-    h = murmur3 0 . into . show $ ix+    h = murmur3 0 . unTagged . from @String @(Encoding.UTF_8 ByteString) . show $ ix      genBiome Big Hard Natural       | sample ix cl0 > 0.5 = (StoneT, Just "mountain")

@@ -81,7 +81,8 @@ reservedWords =   map (syntax . constInfo) (filter isUserFunc allConst)     ++ map (dirSyntax . dirInfo) allDirs-    ++ [ "unit"+    ++ [ "void"+       , "unit"        , "int"        , "text"        , "dir"@@ -204,7 +205,8 @@  parseTypeAtom :: Parser Type parseTypeAtom =-  TyUnit <$ reserved "unit"+  TyVoid <$ reserved "void"+    <|> TyUnit <$ reserved "unit"     <|> TyVar <$> identifier     <|> TyInt <$ reserved "int"     <|> TyText <$ reserved "text"

@@ -55,6 +55,7 @@ pparens False = id  instance PrettyPrec BaseTy where+  prettyPrec _ BVoid = "void"   prettyPrec _ BUnit = "unit"   prettyPrec _ BInt = "int"   prettyPrec _ BDir = "dir"

@@ -42,6 +42,7 @@   check,   decomposeCmdTy,   decomposeFunTy,+  isSimpleUType, ) where  import Control.Category ((>>>))

@@ -0,0 +1,20 @@+{-# LANGUAGE TemplateHaskell #-}++module Swarm.Language.Typed (Typed (..), value, polytype, requires) where++import Control.Lens (makeLenses)+import Data.Aeson (ToJSON)+import Data.Aeson.Types (FromJSON)+import GHC.Generics (Generic)+import Swarm.Language.Requirement (Requirements)+import Swarm.Language.Types (Polytype)++-- | A value, or a hole, or something else that has its type & requirements fixed+data Typed v = Typed+  { _value :: v+  , _polytype :: Polytype+  , _requires :: Requirements+  }+  deriving (Show, Eq, Generic, FromJSON, ToJSON)++makeLenses ''Typed

@@ -23,6 +23,7 @@   tyVars,   pattern TyBase,   pattern TyVar,+  pattern TyVoid,   pattern TyUnit,   pattern TyInt,   pattern TyText,@@ -39,6 +40,7 @@   UType,   pattern UTyBase,   pattern UTyVar,+  pattern UTyVoid,   pattern UTyUnit,   pattern UTyInt,   pattern UTyText,@@ -97,7 +99,9 @@  -- | Base types. data BaseTy-  = -- | The unit type, with a single inhabitant.+  = -- | The void type, with no inhabitants.+    BVoid+  | -- | The unit type, with a single inhabitant.     BUnit   | -- | Signed, arbitrary-size integers.     BInt@@ -290,6 +294,9 @@ pattern TyVar :: Var -> Type pattern TyVar v = Fix (TyVarF v) +pattern TyVoid :: Type+pattern TyVoid = Fix (TyBaseF BVoid)+ pattern TyUnit :: Type pattern TyUnit = Fix (TyBaseF BUnit) @@ -334,6 +341,9 @@  pattern UTyVar :: Var -> UType pattern UTyVar v = UTerm (TyVarF v)++pattern UTyVoid :: UType+pattern UTyVoid = UTerm (TyBaseF BVoid)  pattern UTyUnit :: UType pattern UTyUnit = UTerm (TyBaseF BUnit)

@@ -40,8 +40,8 @@  import Brick hiding (Direction) import Brick.Focus-import Brick.Forms import Brick.Widgets.Dialog+import Brick.Widgets.Edit (handleEditorEvent) import Brick.Widgets.List (handleListEvent) import Brick.Widgets.List qualified as BL import Control.Carrier.Lift qualified as Fused@@ -57,6 +57,7 @@ import Data.List.NonEmpty qualified as NE import Data.Map qualified as M import Data.Maybe (fromMaybe, isJust, mapMaybe)+import Data.String (fromString) import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Time (getZonedTime)@@ -77,7 +78,9 @@ import Swarm.Language.Pretty import Swarm.Language.Requirement qualified as R import Swarm.Language.Syntax+import Swarm.Language.Typed (Typed (..)) import Swarm.Language.Types+import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder) import Swarm.TUI.List import Swarm.TUI.Model import Swarm.TUI.View (generateModal)@@ -155,10 +158,10 @@           -- Extract the first tutorial challenge and run it           let firstTutorial = case scOrder tutorialCollection of                 Just (t : _) -> case M.lookup t (scMap tutorialCollection) of-                  Just (SISingle scene si) -> (scene, si)+                  Just (SISingle siPair) -> siPair                   _ -> error "No first tutorial found!"                 _ -> error "No first tutorial found!"-          uncurry startGame firstTutorial Nothing+          startGame firstTutorial Nothing         Messages -> do           runtimeState . eventLog . notificationsCount .= 0           uiState . uiMenu .= MessagesMenu@@ -194,7 +197,7 @@   Key V.KEnter ->     case snd <$> BL.listSelectedElement curMenu of       Nothing -> continueWithoutRedraw-      Just (SISingle scene si) -> startGame scene si Nothing+      Just (SISingle siPair) -> startGame siPair Nothing       Just (SICollection _ c) -> do         cheat <- use $ uiState . uiCheatMode         uiState . uiMenu .= NewGameMenu (NE.cons (mkScenarioList cheat c) scenarioStack)@@ -255,6 +258,16 @@     ControlKey 'g' -> case s ^. uiState . uiGoal of       Just g | g /= [] -> toggleModal (GoalModal g)       _ -> continueWithoutRedraw+    MetaKey 'h' -> do+      t <- liftIO $ getTime Monotonic+      h <- use $ uiState . uiHideRobotsUntil+      if h >= t+        then -- ignore repeated keypresses+          continueWithoutRedraw+        else -- hide for two seconds+        do+          uiState . uiHideRobotsUntil .= t + TimeSpec 2 0+          invalidateCacheEntry WorldCache     -- pausing and stepping     ControlKey 'p' | isRunning -> safeTogglePause     ControlKey 'o' | isRunning -> do@@ -279,10 +292,10 @@         WorldPanel -> do           mouseCoordsM <- Brick.zoom gameState (mouseLocToWorldCoords mouseLoc)           uiState . uiWorldCursor .= mouseCoordsM-        REPLPanel ->-          -- Do not clear the world cursor when going back to the REPL-          continueWithoutRedraw-        _ -> uiState . uiWorldCursor .= Nothing >> continueWithoutRedraw+        REPLInput -> do+          setFocus REPLPanel+          handleREPLEvent ev+        _ -> continueWithoutRedraw     MouseUp n _ _mouseLoc -> do       case n of         InventoryListItem pos -> uiState . uiInventory . traverse . _2 %= BL.listMoveTo pos@@ -370,7 +383,9 @@     toggleModal QuitModal     case dialogSelection <$> mdialog of       Just (Just QuitButton) -> quitGame-      Just (Just (NextButton scene)) -> saveScenarioInfoOnQuit >> uncurry startGame scene Nothing+      Just (Just KeepPlayingButton) -> toggleModal KeepPlayingModal+      Just (Just (StartOverButton currentSeed siPair)) -> restartGame currentSeed siPair+      Just (Just (NextButton siPair)) -> saveScenarioInfoOnQuit >> startGame siPair Nothing       _ -> return ()   ev -> do     Brick.zoom (uiState . uiModal . _Just . modalDialog) (handleDialogEvent ev)@@ -419,7 +434,7 @@ -- * returns to the previous menu quitGame :: EventM Name AppState () quitGame = do-  history <- use $ uiState . uiReplHistory+  history <- use $ uiState . uiREPL . replHistory   let hist = mapMaybe getREPLEntry $ getLatestREPLHistoryItems maxBound history   liftIO $ (`T.appendFile` T.unlines hist) =<< getSwarmHistoryPath True   saveScenarioInfoOnQuit@@ -582,16 +597,22 @@   -- Now check if the base finished running a program entered at the REPL.   replUpdated <- case g ^. replStatus of     -- It did, and the result was the unit value.  Just reset replStatus.-    REPLWorking _ (Just VUnit) -> do-      gameState . replStatus .= REPLDone (Just (PolyUnit, VUnit))+    REPLWorking (Typed (Just VUnit) typ reqs) -> do+      gameState . replStatus .= REPLDone (Just $ Typed VUnit typ reqs)       pure True      -- It did, and returned some other value.  Pretty-print the     -- result as a REPL output, with its type, and reset the replStatus.-    REPLWorking pty (Just v) -> do-      let out = T.intercalate " " [into (prettyValue v), ":", prettyText (stripCmd pty)]-      uiState . uiReplHistory %= addREPLItem (REPLOutput out)-      gameState . replStatus .= REPLDone (Just (pty, v))+    REPLWorking (Typed (Just v) pty reqs) -> do+      let finalType = stripCmd pty+      let val = Typed v finalType reqs+      itIx <- use (gameState . replNextValueIndex)+      let itName = fromString $ "it" ++ show itIx+      let out = T.intercalate " " [itName, ":", prettyText finalType, "=", into (prettyValue v)]+      uiState . uiREPL . replHistory %= addREPLItem (REPLOutput out)+      gameState . replStatus .= REPLDone (Just val)+      gameState . baseRobot . robotContext . at itName .= Just val+      gameState . replNextValueIndex %= (+ 1)       pure True      -- Otherwise, do nothing.@@ -677,6 +698,8 @@       gs <- use gameState       gameState . world %= W.loadRegion (viewingRegion gs (over both fromIntegral size)) +-- | Strips top-level `cmd` from type (in case of REPL evaluation),+--   and returns a boolean to indicate if it happened stripCmd :: Polytype -> Polytype stripCmd (Forall xs (TyCmd ty)) = Forall xs ty stripCmd pty = pty@@ -685,147 +708,195 @@ -- REPL events ------------------------------------------------------------ +-- | Set the REPLForm to the given value, resetting type error checks to Nothing+--   and removing uiError.+resetREPL :: T.Text -> REPLPrompt -> UIState -> UIState+resetREPL t r ui =+  ui+    & uiREPL . replPromptText .~ t+    & uiREPL . replPromptType .~ r+    & uiError .~ Nothing+ -- | Handle a user input event for the REPL. handleREPLEvent :: BrickEvent Name AppEvent -> EventM Name AppState () handleREPLEvent = \case   ControlKey 'c' -> do-    gameState . robotMap . ix 0 . machine %= cancel-    uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt "")+    gameState . baseRobot . machine %= cancel+    uiState . uiREPL . replPromptType .= CmdPrompt []   Key V.KEnter -> do     s <- get-    let entry = formState (s ^. uiState . uiReplForm)-        topTypeCtx = s ^. gameState . robotMap . ix 0 . robotContext . defTypes-        topReqCtx = s ^. gameState . robotMap . ix 0 . robotContext . defReqs-        topValCtx = s ^. gameState . robotMap . ix 0 . robotContext . defVals-        topStore =-          fromMaybe emptyStore $-            s ^? gameState . robotMap . at 0 . _Just . robotContext . defStore-        startBaseProgram t@(ProcessedTerm _ (Module ty _) _ _) =-          (gameState . replStatus .~ REPLWorking ty Nothing)-            . (gameState . robotMap . ix 0 . machine .~ initMachine t topValCtx topStore)+    let topCtx = topContext s+        repl = s ^. uiState . uiREPL+        uinput = repl ^. replPromptText++        startBaseProgram t@(ProcessedTerm _ (Module ty _) reqs _) =+          (gameState . replStatus .~ REPLWorking (Typed Nothing ty reqs))+            . (gameState . baseRobot . machine .~ initMachine t (topCtx ^. defVals) (topCtx ^. defStore))             . (gameState %~ execState (activateRobot 0))      if not $ s ^. gameState . replWorking-      then case entry of-        CmdPrompt uinput _ ->-          case processTerm' topTypeCtx topReqCtx uinput of+      then case repl ^. replPromptType of+        CmdPrompt _ ->+          case processTerm' (topCtx ^. defTypes) (topCtx ^. defReqs) uinput of             Right mt -> do-              uiState %= resetWithREPLForm (set promptUpdateL "" (s ^. uiState))-              uiState . uiReplHistory %= addREPLItem (REPLEntry uinput)+              uiState %= resetREPL "" (CmdPrompt [])+              uiState . uiREPL . replHistory %= addREPLItem (REPLEntry uinput)               modify $ maybe id startBaseProgram mt             Left err -> uiState . uiError ?= err-        SearchPrompt t hist ->-          case lastEntry t hist of-            Nothing -> uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt "")+        SearchPrompt hist ->+          case lastEntry uinput hist of+            Nothing -> uiState %= resetREPL "" (CmdPrompt [])             Just found-              | T.null t -> uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt "")+              | T.null uinput -> uiState %= resetREPL "" (CmdPrompt [])               | otherwise -> do-                uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt found)+                uiState %= resetREPL found (CmdPrompt [])                 modify validateREPLForm       else continueWithoutRedraw   Key V.KUp -> modify $ adjReplHistIndex Older   Key V.KDown -> modify $ adjReplHistIndex Newer   ControlKey 'r' -> do     s <- get-    case s ^. uiState . uiReplForm . to formState of-      CmdPrompt uinput _ ->-        let newform = mkReplForm $ SearchPrompt uinput (s ^. uiState . uiReplHistory)-         in uiState . uiReplForm .= newform-      SearchPrompt ftext rh -> case lastEntry ftext rh of+    let uinput = s ^. uiState . uiREPL . replPromptText+    case s ^. uiState . uiREPL . replPromptType of+      CmdPrompt _ -> uiState . uiREPL . replPromptType .= SearchPrompt (s ^. uiState . uiREPL . replHistory)+      SearchPrompt rh -> case lastEntry uinput rh of         Nothing -> pure ()-        Just found ->-          let newform = mkReplForm $ SearchPrompt ftext (removeEntry found rh)-           in uiState . uiReplForm .= newform+        Just found -> uiState . uiREPL . replPromptType .= SearchPrompt (removeEntry found rh)   CharKey '\t' -> do-    formSt <- use $ uiState . uiReplForm . to formState-    newform <- gets $ mkReplForm . flip tabComplete formSt-    uiState . uiReplForm .= newform+    s <- get+    let names = s ^.. gameState . baseRobot . robotContext . defTypes . to assocs . traverse . _1+    uiState . uiREPL %= tabComplete names (s ^. gameState . entityMap)     modify validateREPLForm   EscapeKey -> do-    formSt <- use $ uiState . uiReplForm . to formState+    formSt <- use $ uiState . uiREPL . replPromptType     case formSt of       CmdPrompt {} -> continueWithoutRedraw-      SearchPrompt _ _ ->-        uiState %= resetWithREPLForm (mkReplForm $ mkCmdPrompt "")+      SearchPrompt _ ->+        uiState %= resetREPL "" (CmdPrompt [])   ControlKey 'd' -> do-    text <- use $ uiState . uiReplForm . to formState . promptTextL+    text <- use $ uiState . uiREPL . replPromptText     if text == T.empty       then toggleModal QuitModal       else continueWithoutRedraw+  -- finally if none match pass the event to the editor   ev -> do-    replForm <- use $ uiState . uiReplForm-    f' <- nestEventM' replForm (handleFormEvent ev)-    case formState f' of-      CmdPrompt {} -> do-        uiState . uiReplForm .= f'-        modify validateREPLForm-      SearchPrompt t _ -> do-        -- TODO: why does promptUpdateL not update the uiState?-        newform <- use $ uiState . to (set promptUpdateL t)-        uiState . uiReplForm .= newform+    Brick.zoom (uiState . uiREPL . replPromptEditor) (handleEditorEvent ev)+    uiState . uiREPL . replPromptType %= \case+      CmdPrompt _ -> CmdPrompt [] -- reset completions on any event passed to editor+      SearchPrompt a -> SearchPrompt a+    modify validateREPLForm --- | Try to complete the last word in a partially entered REPL prompt using---   things reserved words and names in scope.-tabComplete :: AppState -> REPLPrompt -> REPLPrompt-tabComplete _ p@(SearchPrompt {}) = p-tabComplete s (CmdPrompt t mms)-  | (m : ms) <- mms = CmdPrompt (replaceLast m t) (ms ++ [m])-  | T.null lastWord = CmdPrompt t []-  | otherwise = case matches of-    [] -> CmdPrompt t []-    [m] -> CmdPrompt (completeWith m) []-    (m : ms) -> CmdPrompt (completeWith m) (ms ++ [m])+data CompletionType+  = FunctionName+  | EntityName+  deriving (Eq)++-- | Try to complete the last word in a partially-entered REPL prompt using+--   reserved words and names in scope (in the case of function names) or+--   entity names (in the case of string literals).+tabComplete :: [Var] -> EntityMap -> REPLState -> REPLState+tabComplete names em repl = case repl ^. replPromptType of+  SearchPrompt _ -> repl+  CmdPrompt mms+    -- Case 1: If completion candidates have already been+    -- populated via case (3), cycle through them.+    -- Note that tabbing through the candidates *does* update the value+    -- of "t", which one might think would narrow the candidate list+    -- to only that match and therefore halt the cycling.+    -- However, the candidate list only gets recomputed (repopulated)+    -- if the user subsequently presses a non-Tab key. Thus the current+    -- value of "t" is ignored for all Tab presses subsequent to the+    -- first.+    | (m : ms) <- mms -> setCmd (replacementFunc m) (ms ++ [m])+    -- Case 2: Require at least one letter to be typed in order to offer completions for+    -- function names.+    -- We allow suggestions for Entity Name strings without anything having been typed.+    | T.null lastWord && completionType == FunctionName -> setCmd t []+    -- Case 3: Typing another character in the REPL clears the completion candidates from+    -- the CmdPrompt, so when Tab is pressed again, this case then gets executed and+    -- repopulates them.+    | otherwise -> case candidateMatches of+      [] -> setCmd t []+      [m] -> setCmd (completeWith m) []+      -- Perform completion with the first candidate, then populate the list+      -- of all candidates with the current completion moved to the back+      -- of the queue.+      (m : ms) -> setCmd (completeWith m) (ms ++ [m])  where-  completeWith m = T.append t (T.drop (T.length lastWord) m)-  lastWord = T.takeWhileEnd isIdentChar t-  names = s ^.. gameState . robotMap . ix 0 . robotContext . defTypes . to assocs . traverse . _1+  -- checks the "parity" of the number of quotes. If odd, then there is an open quote.+  hasOpenQuotes = (== 1) . (`mod` 2) . T.count "\""++  completionType =+    if hasOpenQuotes t+      then EntityName+      else FunctionName++  replacementFunc = T.append $ T.dropWhileEnd replacementBoundaryPredicate t+  completeWith m = T.append t $ T.drop (T.length lastWord) m+  lastWord = T.takeWhileEnd replacementBoundaryPredicate t+  candidateMatches = filter (lastWord `T.isPrefixOf`) replacementCandidates++  (replacementCandidates, replacementBoundaryPredicate) = case completionType of+    EntityName -> (entityNames, (/= '"'))+    FunctionName -> (possibleWords, isIdentChar)+   possibleWords = reservedWords ++ names-  matches = filter (lastWord `T.isPrefixOf`) possibleWords +  entityNames = M.keys $ entitiesByName em++  t = repl ^. replPromptText+  setCmd nt ms =+    repl+      & replPromptText .~ nt+      & replPromptType .~ CmdPrompt ms+ -- | Validate the REPL input when it changes: see if it parses and --   typechecks, and set the color accordingly. validateREPLForm :: AppState -> AppState validateREPLForm s =   case replPrompt of-    CmdPrompt "" _ ->-      let theType = s ^. gameState . replStatus . replActiveType-       in s & uiState . uiReplType .~ theType-    CmdPrompt uinput _ ->-      let result = processTerm' topTypeCtx topReqCtx uinput-          theType = case result of-            Right (Just (ProcessedTerm _ (Module ty _) _ _)) -> Just ty-            _ -> Nothing-       in s-            & uiState . uiReplForm %~ validate result-            & uiState . uiReplType .~ theType-    SearchPrompt _ _ -> s+    CmdPrompt _+      | T.null uinput ->+        let theType = s ^. gameState . replStatus . replActiveType+         in s & uiState . uiREPL . replType .~ theType+    CmdPrompt _+      | otherwise ->+        let result = processTerm' (topCtx ^. defTypes) (topCtx ^. defReqs) uinput+            theType = case result of+              Right (Just (ProcessedTerm _ (Module ty _) _ _)) -> Just ty+              _ -> Nothing+         in s+              & uiState . uiREPL . replValid .~ isRight result+              & uiState . uiREPL . replType .~ theType+    SearchPrompt _ -> s  where-  replPrompt = s ^. uiState . uiReplForm . to formState-  topTypeCtx = s ^. gameState . robotMap . ix 0 . robotContext . defTypes-  topReqCtx = s ^. gameState . robotMap . ix 0 . robotContext . defReqs-  validate result = setFieldValid (isRight result) REPLInput+  uinput = s ^. uiState . uiREPL . replPromptText+  replPrompt = s ^. uiState . uiREPL . replPromptType+  topCtx = topContext s  -- | Update our current position in the REPL history. adjReplHistIndex :: TimeDir -> AppState -> AppState adjReplHistIndex d s =-  ns-    & (if replIndexIsAtInput (s ^. repl) then saveLastEntry else id)-    & (if oldEntry /= newEntry then showNewEntry else id)+  s+    & uiState . uiREPL %~ moveREPL     & validateREPLForm  where-  -- new AppState after moving the repl index-  ns = s & repl %~ moveReplHistIndex d oldEntry--  repl :: Lens' AppState REPLHistory-  repl = uiState . uiReplHistory+  moveREPL :: REPLState -> REPLState+  moveREPL repl =+    newREPL+      & (if replIndexIsAtInput (repl ^. replHistory) then saveLastEntry else id)+      & (if oldEntry /= newEntry then showNewEntry else id)+   where+    -- new AppState after moving the repl index+    newREPL :: REPLState+    newREPL = repl & replHistory %~ moveReplHistIndex d oldEntry -  replLast = s ^. uiState . uiReplLast-  saveLastEntry = uiState . uiReplLast .~ (s ^. uiState . uiReplForm . to formState . promptTextL)-  showNewEntry = uiState . uiReplForm %~ updateFormState (mkCmdPrompt newEntry)-  -- get REPL data-  getCurrEntry = fromMaybe replLast . getCurrentItemText . view repl-  oldEntry = getCurrEntry s-  newEntry = getCurrEntry ns+    saveLastEntry = replLast .~ (repl ^. replPromptText)+    showNewEntry = (replPromptEditor .~ newREPLEditor newEntry) . (replPromptType .~ CmdPrompt [])+    -- get REPL data+    getCurrEntry = fromMaybe (repl ^. replLast) . getCurrentItemText . view replHistory+    oldEntry = getCurrEntry repl+    newEntry = getCurrEntry newREPL  ------------------------------------------------------------ -- World events@@ -901,6 +972,12 @@   (CharKey '0') -> do     uiState . uiInventoryShouldUpdate .= True     uiState . uiShowZero %= not+  (CharKey ';') -> do+    uiState . uiInventoryShouldUpdate .= True+    uiState . uiInventorySort %= cycleSortOrder+  (CharKey ':') -> do+    uiState . uiInventoryShouldUpdate .= True+    uiState . uiInventorySort %= cycleSortDirection   (VtyEvent ev) -> do     -- This does not work we want to skip redrawing in the no-list case     -- Brick.zoom (uiState . uiInventory . _Just . _2) (handleListEventWithSeparators ev (is _Separator))@@ -918,16 +995,17 @@ makeEntity e = do   s <- get   let mkTy = PolyUnit+      mkReq = R.singletonCap CMake       mkProg = TApp (TConst Make) (TText (e ^. entityName))-      mkPT = ProcessedTerm mkProg (Module mkTy empty) (R.singletonCap CMake) empty+      mkPT = ProcessedTerm mkProg (Module mkTy empty) mkReq empty       topStore =         fromMaybe emptyStore $-          s ^? gameState . robotMap . at 0 . _Just . robotContext . defStore+          s ^? gameState . baseRobot . robotContext . defStore -  case isActive <$> (s ^. gameState . robotMap . at 0) of+  case isActive <$> (s ^? gameState . baseRobot) of     Just False -> do-      gameState . replStatus .= REPLWorking mkTy Nothing-      gameState . robotMap . ix 0 . machine .= initMachine mkPT empty topStore+      gameState . replStatus .= REPLWorking (Typed Nothing mkTy mkReq)+      gameState . baseRobot . machine .= initMachine mkPT empty topStore       gameState %= execState (activateRobot 0)     _ -> continueWithoutRedraw 

@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module Swarm.TUI.Inventory.Sorting (+  InventorySortOptions (..),+  InventorySortDirection (..),+  InventorySortOrder (..),+  cycleSortOrder,+  cycleSortDirection,+  defaultSortOptions,+  sortInventory,+  renderSortMethod,+) where++import Algorithms.NaturalSort (sortKey)+import Control.Lens (view)+import Data.List (sortBy)+import Data.Ord (Down (Down), comparing)+import Data.Text qualified as T+import Swarm.Game.Entity as E+import Swarm.Util (cycleEnum)++data InventorySortDirection+  = Ascending+  | Descending+  deriving (Enum, Bounded, Eq)++data InventorySortOrder+  = ByNaturalAlphabetic+  | ByQuantity+  | ByType+  deriving (Enum, Bounded, Eq)++data InventorySortOptions = InventorySortOptions InventorySortDirection InventorySortOrder++defaultSortOptions :: InventorySortOptions+defaultSortOptions = InventorySortOptions Ascending ByNaturalAlphabetic++renderSortMethod :: InventorySortOptions -> T.Text+renderSortMethod (InventorySortOptions direction order) =+  T.unwords [prefix, label]+ where+  prefix = case direction of+    Ascending -> "↑"+    Descending -> "↓"+  label = case order of+    ByNaturalAlphabetic -> "name"+    ByQuantity -> "count"+    ByType -> "type"++cycleSortOrder :: InventorySortOptions -> InventorySortOptions+cycleSortOrder (InventorySortOptions direction order) =+  InventorySortOptions direction (cycleEnum order)++cycleSortDirection :: InventorySortOptions -> InventorySortOptions+cycleSortDirection (InventorySortOptions direction order) =+  InventorySortOptions (cycleEnum direction) order++-- | All non-alphabetic sort criteria perform alphabetic tie-breaking.+-- "Reverse ordering" only applies to the *primary* sort criteria; the secondary+-- alphabetic sort is always in ascending order.+getSortCompartor :: Ord a => InventorySortOptions -> (a, Entity) -> (a, Entity) -> Ordering+getSortCompartor (InventorySortOptions direction order) = case order of+  ByNaturalAlphabetic -> compReversible (alphabetic . snd)+  ByQuantity -> compReversible fst <> secondary+  ByType -> compReversible (view entityProperties . snd) <> secondary+ where+  alphabetic = sortKey . T.toLower . view entityName+  secondary = comparing (alphabetic . snd)++  compReversible :: Ord a => (b -> a) -> b -> b -> Ordering+  compReversible = case direction of+    Ascending -> comparing+    Descending -> \f -> comparing (Down . f)++sortInventory :: Ord a => InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]+sortInventory opts =+  sortBy $ getSortCompartor opts

@@ -53,13 +53,7 @@    -- ** Prompt utils   REPLPrompt (..),-  mkCmdPrompt,-  replPromptAsWidget,-  promptTextL,-  promptUpdateL,-  mkReplForm,   removeEntry,-  resetWithREPLForm,    -- ** Inventory   InventoryListEntry (..),@@ -74,11 +68,9 @@   uiCheatMode,   uiFocusRing,   uiWorldCursor,-  uiReplForm,-  uiReplType,-  uiReplHistory,-  uiReplLast,+  uiREPL,   uiInventory,+  uiInventorySort,   uiMoreInfoTop,   uiMoreInfoBot,   uiScrollToEnd,@@ -94,15 +86,29 @@   lastInfoTime,   uiShowFPS,   uiShowZero,+  uiShowRobots,+  uiHideRobotsUntil,   uiInventoryShouldUpdate,   uiTPF,   uiFPS,+  scenarioRef,   appData, +  -- *** REPL Panel Model+  REPLState,+  replPromptType,+  replPromptEditor,+  replPromptText,+  replValid,+  replLast,+  replType,+  replHistory,+  newREPLEditor,+   -- ** Initialization   initFocusRing,   defaultPrompt,-  initReplForm,+  initREPLState,   initLgTicksPerSecond,   initUIState,   lastEntry,@@ -129,10 +135,12 @@   AppOpts (..),   initAppState,   startGame,+  restartGame,   scenarioToAppState,   Seed,    -- ** Utility+  topContext,   focusedItem,   focusedEntity,   nextScenario,@@ -141,16 +149,16 @@  import Brick import Brick.Focus-import Brick.Forms import Brick.Widgets.Dialog (Dialog)+import Brick.Widgets.Edit (Editor, applyEdit, editorText, getEditContents) import Brick.Widgets.List qualified as BL-import Control.Applicative (Applicative (liftA2))+import Control.Applicative (Applicative (liftA2), (<|>)) import Control.Lens hiding (from, (<.>)) import Control.Monad.Except import Control.Monad.State import Data.Bits (FiniteBits (finiteBitSize)) import Data.Foldable (toList)-import Data.List (findIndex, sortOn)+import Data.List (findIndex) import Data.List.NonEmpty (NonEmpty (..)) import Data.List.NonEmpty qualified as NE import Data.Map (Map)@@ -160,16 +168,19 @@ import Data.Sequence qualified as Seq import Data.Text (Text) import Data.Text qualified as T+import Data.Text.Zipper qualified as TZ import Data.Time (getZonedTime) import Data.Vector qualified as V+import GitHash (GitInfo) import Linear (zero) import Network.Wai.Handler.Warp (Port) import Swarm.Game.Entity as E import Swarm.Game.Robot-import Swarm.Game.Scenario (Scenario, loadScenario)+import Swarm.Game.Scenario (loadScenario) import Swarm.Game.ScenarioInfo (   ScenarioCollection,   ScenarioInfo (..),+  ScenarioInfoPair,   ScenarioItem (..),   ScenarioStatus (..),   normalizeScenarioPath,@@ -177,12 +188,14 @@   scenarioCollectionToList,   scenarioItemByPath,   scenarioPath,+  scenarioSolution,   scenarioStatus,   _SISingle,  ) import Swarm.Game.State import Swarm.Game.World qualified as W import Swarm.Language.Types+import Swarm.TUI.Inventory.Sorting import Swarm.Util import Swarm.Version (NewReleaseFailure (NoMainUpstreamRelease)) import System.Clock@@ -356,19 +369,12 @@ replIndexIsAtInput :: REPLHistory -> Bool replIndexIsAtInput repl = repl ^. replIndex == replLength repl ---------------------------------------------------------------- Repl Prompt----------------------------------------------------------------- | This data type represent what is prompted to the player---   and how the REPL show interpret the user input.-data REPLPrompt-  = -- | Interpret the given text as a regular command.-    --   The list is for potential completions, which we can-    --   cycle through by hitting Tab repeatedly-    CmdPrompt Text [Text]-  | -- | Interpret the given text as "search this text in history"-    SearchPrompt Text REPLHistory+-- | Given some text,  removes the REPLEntry within REPLHistory which is equal to that.+--   This is used when the user enters in search mode and want to traverse the history.+--   If a command has been used many times, the history will be populated with it causing+--   the effect that search command always finds the same command.+removeEntry :: Text -> REPLHistory -> REPLHistory+removeEntry foundtext hist = hist & replSeq %~ Seq.filter (/= REPLEntry foundtext)  -- | Get the last REPLEntry in REPLHistory matching the given text lastEntry :: Text -> REPLHistory -> Maybe Text@@ -380,49 +386,73 @@   matchesText histItem = t `T.isInfixOf` replItemText histItem   matchEntry = liftA2 (&&) matchesText isREPLEntry --- | Given some text,  removes the REPLEntry within REPLHistory which is equal to that.---   This is used when the user enters in search mode and want to traverse the history.---   If a command has been used many times, the history will be populated with it causing---   the effect that search command always finds the same command.-removeEntry :: Text -> REPLHistory -> REPLHistory-removeEntry foundtext hist = hist & replSeq %~ Seq.filter (/= REPLEntry foundtext)+------------------------------------------------------------+-- REPL+------------------------------------------------------------ -mkCmdPrompt :: Text -> REPLPrompt-mkCmdPrompt t = CmdPrompt t []+-- | This data type tells us how to interpret the text typed+--   by the player at the prompt (which is stored in Editor).+data REPLPrompt+  = -- | Interpret the prompt text as a regular command.+    --   The list is for potential completions, which we can+    --   cycle through by hitting Tab repeatedly+    CmdPrompt [Text]+  | -- | Interpret the prompt text as "search this text in history"+    SearchPrompt REPLHistory  defaultPrompt :: REPLPrompt-defaultPrompt = mkCmdPrompt ""+defaultPrompt = CmdPrompt [] --- | Lens for accesing the text of the prompt.---   Notice that setting the text clears any pending completions.-promptTextL :: Lens' REPLPrompt Text-promptTextL = lens g s+data REPLState = REPLState+  { _replPromptType :: REPLPrompt+  , _replPromptEditor :: Editor Text Name+  , _replValid :: Bool+  , _replLast :: Text+  , _replType :: Maybe Polytype+  , _replHistory :: REPLHistory+  }++newREPLEditor :: Text -> Editor Text Name+newREPLEditor t = applyEdit gotoEnd $ editorText REPLInput (Just 1) t  where-  -- Notice that the prompt ADT must have a Text field in every constructor (representing what the user writes).-  -- This should be force in the ADT itself... right know this here-  -- The compiler will complain about "Non complete patterns" on this two function.-  g :: REPLPrompt -> Text-  g (CmdPrompt t _) = t-  g (SearchPrompt t _) = t+  ls = T.lines t+  pos = (length ls - 1, T.length (last ls))+  gotoEnd = if null ls then id else TZ.moveCursor pos -  s :: REPLPrompt -> Text -> REPLPrompt-  s (CmdPrompt _ _) t = mkCmdPrompt t-  s (SearchPrompt _ h) t = SearchPrompt t h+initREPLState :: REPLHistory -> REPLState+initREPLState = REPLState defaultPrompt (newREPLEditor "") True "" Nothing --- | Turn the repl prompt into a decorator for the form-replPromptAsWidget :: REPLPrompt -> Widget Name-replPromptAsWidget (CmdPrompt {}) = txt "> "-replPromptAsWidget (SearchPrompt t rh) =-  case lastEntry t rh of-    Nothing -> txt "[nothing found] "-    Just lastentry-      | T.null t -> txt "[find] "-      | otherwise -> txt $ "[found: \"" <> lastentry <> "\"] "+makeLensesWith (lensRules & generateSignatures .~ False) ''REPLState --- | Creates the repl form as a decorated form.-mkReplForm :: REPLPrompt -> Form REPLPrompt AppEvent Name-mkReplForm r = newForm [(replPromptAsWidget r <+>) @@= editTextField promptTextL REPLInput (Just 1)] r+-- | The way we interpret text typed by the player in the REPL prompt.+replPromptType :: Lens' REPLState REPLPrompt +-- | The prompt where the user can type input at the REPL.+replPromptEditor :: Lens' REPLState (Editor Text Name)++-- | Convinience lens to get text from editor and replace it with new+--   one that has the provided text.+replPromptText :: Lens' REPLState Text+replPromptText = lens g s+ where+  g r = r ^. replPromptEditor . to getEditContents . to T.concat+  s r t = r & replPromptEditor .~ newREPLEditor t++-- | Whether the prompt text is a valid 'Term'.+replValid :: Lens' REPLState Bool++-- | The type of the current REPL input which should be displayed to+--   the user (if any).+replType :: Lens' REPLState (Maybe Polytype)++-- | The last thing the user has typed which isn't part of the history.+--   This is used to restore the repl form after the user visited the history.+replLast :: Lens' REPLState Text++-- | History of things the user has typed at the REPL, interleaved+--   with outputs the system has generated.+replHistory :: Lens' REPLState REPLHistory+ ------------------------------------------------------------ -- Menus and dialogs ------------------------------------------------------------@@ -435,11 +465,12 @@   | RobotsModal   | WinModal   | QuitModal+  | KeepPlayingModal   | DescriptionModal Entity   | GoalModal [Text]   deriving (Eq, Show) -data ButtonSelection = CancelButton | QuitButton | NextButton (Scenario, ScenarioInfo)+data ButtonSelection = CancelButton | KeepPlayingButton | StartOverButton Seed ScenarioInfoPair | QuitButton | NextButton ScenarioInfoPair  data Modal = Modal   { _modalType :: ModalType@@ -481,7 +512,7 @@   go (Just curSC) (thing : rest) stk = go nextSC rest (lst : stk)    where     hasName :: ScenarioItem -> Bool-    hasName (SISingle _ (ScenarioInfo pth _ _ _)) = takeFileName pth == thing+    hasName (SISingle (_, ScenarioInfo pth _ _ _)) = takeFileName pth == thing     hasName (SICollection nm _) = nm == into @Text (dropTrailingPathSeparator thing)      lst = BL.listFindBy hasName (mkScenarioList cheat curSC)@@ -519,11 +550,9 @@   , _uiCheatMode :: Bool   , _uiFocusRing :: FocusRing Name   , _uiWorldCursor :: Maybe W.Coords-  , _uiReplForm :: Form REPLPrompt AppEvent Name-  , _uiReplType :: Maybe Polytype-  , _uiReplLast :: Text-  , _uiReplHistory :: REPLHistory+  , _uiREPL :: REPLState   , _uiInventory :: Maybe (Int, BL.List Name InventoryListEntry)+  , _uiInventorySort :: InventorySortOptions   , _uiMoreInfoTop :: Bool   , _uiMoreInfoBot :: Bool   , _uiScrollToEnd :: Bool@@ -532,6 +561,7 @@   , _uiGoal :: Maybe [Text]   , _uiShowFPS :: Bool   , _uiShowZero :: Bool+  , _uiHideRobotsUntil :: TimeSpec   , _uiInventoryShouldUpdate :: Bool   , _uiTPF :: Double   , _uiFPS :: Double@@ -543,6 +573,7 @@   , _accumulatedTime :: TimeSpec   , _lastInfoTime :: TimeSpec   , _appData :: Map Text Text+  , _scenarioRef :: Maybe ScenarioInfoPair   }  --------------------------------------------------@@ -575,20 +606,11 @@ -- | The last clicked position on the world view. uiWorldCursor :: Lens' UIState (Maybe W.Coords) --- | The form where the user can type input at the REPL.-uiReplForm :: Lens' UIState (Form REPLPrompt AppEvent Name)---- | The type of the current REPL input which should be displayed to---   the user (if any).-uiReplType :: Lens' UIState (Maybe Polytype)---- | The last thing the user has typed which isn't part of the history.---   This is used to restore the repl form after the user visited the history.-uiReplLast :: Lens' UIState Text+-- | The state of REPL panel.+uiREPL :: Lens' UIState REPLState --- | History of things the user has typed at the REPL, interleaved---   with outputs the system has generated.-uiReplHistory :: Lens' UIState REPLHistory+-- | The order and direction of sorting inventory list.+uiInventorySort :: Lens' UIState InventorySortOptions  -- | The hash value of the focused robot entity (so we can tell if its --   inventory changed) along with a list of the items in the@@ -623,6 +645,13 @@ -- | A toggle to show or hide inventory items with count 0 by pressing `0` uiShowZero :: Lens' UIState Bool +-- | Hide robots on the world map.+uiHideRobotsUntil :: Lens' UIState TimeSpec++-- | Whether to show or hide robots on the world map.+uiShowRobots :: Getter UIState Bool+uiShowRobots = to (\ui -> ui ^. lastFrameTime > ui ^. uiHideRobotsUntil)+ -- | Whether the Inventory ui panel should update uiInventoryShouldUpdate :: Lens' UIState Bool @@ -632,6 +661,9 @@ -- | Computed frames per milli seconds uiFPS :: Lens' UIState Double +-- | The currently active Scenario description, useful for starting over.+scenarioRef :: Lens' UIState (Maybe ScenarioInfoPair)+ -- | The base-2 logarithm of the current game speed in ticks/second. --   Note that we cap this value to the range of +/- log2 INTMAX. lgTicksPerSecond :: Lens' UIState Int@@ -676,24 +708,6 @@ --   the logo, about page, tutorial story, etc. appData :: Lens' UIState (Map Text Text) --- | Lens for accesing the text of the prompt.---   Notice that setting the text clears any pending completions.-promptUpdateL :: Lens UIState (Form REPLPrompt AppEvent Name) Text Text-promptUpdateL = lens g s- where-  -- Notice that the prompt ADT must have a Text field in every constructor (representing what the user writes).-  -- This should be force in the ADT itself... right know this here-  -- The compiler will complain about "Non complete patterns" on this two function.-  g :: UIState -> Text-  g ui = case formState (ui ^. uiReplForm) of-    CmdPrompt t _ -> t-    SearchPrompt t _ -> t--  s :: UIState -> Text -> Form REPLPrompt AppEvent Name-  s ui inputText = case formState (ui ^. uiReplForm) of-    CmdPrompt _ _ -> mkReplForm $ mkCmdPrompt inputText-    SearchPrompt _ _ -> mkReplForm $ SearchPrompt inputText (ui ^. uiReplHistory)- -- ---------------------------------------------------------------------------- --                                Runtime state                              -- -- ----------------------------------------------------------------------------@@ -793,13 +807,6 @@ initFocusRing :: FocusRing Name initFocusRing = focusRing [REPLPanel, InfoPanel, RobotPanel, WorldPanel] --- | The initial state of the REPL entry form.-initReplForm :: Form REPLPrompt AppEvent Name-initReplForm =-  newForm-    [(replPromptAsWidget defaultPrompt <+>) @@= editTextField promptTextL REPLInput (Just 1)]-    (mkCmdPrompt "")- -- | The initial tick speed. initLgTicksPerSecond :: Int initLgTicksPerSecond = 4 -- 2^4 = 16 ticks / second@@ -822,11 +829,9 @@       , _uiCheatMode = cheatMode       , _uiFocusRing = initFocusRing       , _uiWorldCursor = Nothing-      , _uiReplForm = initReplForm-      , _uiReplType = Nothing-      , _uiReplHistory = newREPLHistory history-      , _uiReplLast = ""+      , _uiREPL = initREPLState $ newREPLHistory history       , _uiInventory = Nothing+      , _uiInventorySort = defaultSortOptions       , _uiMoreInfoTop = False       , _uiMoreInfoBot = False       , _uiScrollToEnd = False@@ -835,6 +840,7 @@       , _uiGoal = Nothing       , _uiShowFPS = False       , _uiShowZero = True+      , _uiHideRobotsUntil = startTime - 1       , _uiInventoryShouldUpdate = False       , _uiTPF = 0       , _uiFPS = 0@@ -846,6 +852,7 @@       , _frameCount = 0       , _frameTickCount = 0       , _appData = appDataMap+      , _scenarioRef = Nothing       }  ------------------------------------------------------------@@ -859,12 +866,13 @@ populateInventoryList (Just r) = do   mList <- preuse (uiInventory . _Just . _2)   showZero <- use uiShowZero+  sortOptions <- use uiInventorySort   let mkInvEntry (n, e) = InventoryEntry n e       mkInstEntry (_, e) = InstalledEntry e       itemList mk label =         (\case [] -> []; xs -> Separator label : xs)           . map mk-          . sortOn (view entityName . snd)+          . sortInventory sortOptions           . filter shouldDisplay           . elems @@ -899,13 +907,6 @@   -- the hash of the current robot.   uiInventory .= Just (r ^. inventoryHash, lst) --- | Set the REPLForm to the given value, resetting type error checks to Nothing---   and removing uiError.-resetWithREPLForm :: Form REPLPrompt AppEvent Name -> UIState -> UIState-resetWithREPLForm f =-  (uiReplForm .~ f)-    . (uiError .~ Nothing)- ------------------------------------------------------------ -- App state (= UI state + game state) initialization ------------------------------------------------------------@@ -917,17 +918,22 @@   , -- | Scenario the user wants to play.     userScenario :: Maybe FilePath   , -- | Code to be run on base.-    toRun :: Maybe FilePath+    scriptToRun :: Maybe FilePath+  , -- | Automatically run the solution defined in the scenario file+    autoPlay :: Bool   , -- | Should cheat mode be enabled?     cheatMode :: Bool   , -- | Explicit port on which to run the web API     userWebPort :: Maybe Port+  , -- | Information about the Git repository (not present in release).+    repoGitInfo :: Maybe GitInfo   }  -- | Initialize the 'AppState'. initAppState :: AppOpts -> ExceptT Text IO AppState initAppState AppOpts {..} = do-  let skipMenu = isJust userScenario || isJust toRun || isJust userSeed+  let isRunningInitialProgram = isJust scriptToRun || autoPlay+      skipMenu = isJust userScenario || isRunningInitialProgram || isJust userSeed   gs <- initGameState   ui <- initUIState (not skipMenu) cheatMode   let rs = initRuntimeState@@ -935,30 +941,49 @@     False -> return $ AppState gs ui rs     True -> do       (scenario, path) <- loadScenario (fromMaybe "classic" userScenario) (gs ^. entityMap)++      let maybeAutoplay = do+            guard autoPlay+            soln <- scenario ^. scenarioSolution+            return $ SuggestedSolution soln+      let realToRun = maybeAutoplay <|> (ScriptPath <$> scriptToRun)+       execStateT-        (startGameWithSeed userSeed scenario (ScenarioInfo path NotStarted NotStarted NotStarted) toRun)+        (startGameWithSeed userSeed (scenario, ScenarioInfo path NotStarted NotStarted NotStarted) realToRun)         (AppState gs ui rs)  -- | Load a 'Scenario' and start playing the game.-startGame :: (MonadIO m, MonadState AppState m) => Scenario -> ScenarioInfo -> Maybe FilePath -> m ()+startGame :: (MonadIO m, MonadState AppState m) => ScenarioInfoPair -> Maybe CodeToRun -> m () startGame = startGameWithSeed Nothing +-- | Re-initialize the game from the stored reference to the current scenario.+--+-- Note that "restarting" is intended only for "scenarios";+-- with some scenarios, it may be possible to get stuck so that it is+-- either impossible or very annoying to win, so being offered an+-- option to restart is more user-friendly.+--+-- Since scenarios are stored as a Maybe in the UI state, we handle the Nothing+-- case upstream so that the Scenario passed to this function definitely exists.+restartGame :: (MonadIO m, MonadState AppState m) => Seed -> ScenarioInfoPair -> m ()+restartGame currentSeed siPair = startGameWithSeed (Just currentSeed) siPair Nothing+ -- | Load a 'Scenario' and start playing the game, with the --   possibility for the user to override the seed.-startGameWithSeed :: (MonadIO m, MonadState AppState m) => Maybe Seed -> Scenario -> ScenarioInfo -> Maybe FilePath -> m ()-startGameWithSeed userSeed scene si toRun = do+startGameWithSeed :: (MonadIO m, MonadState AppState m) => Maybe Seed -> ScenarioInfoPair -> Maybe CodeToRun -> m ()+startGameWithSeed userSeed siPair@(_scene, si) toRun = do   t <- liftIO getZonedTime   ss <- use $ gameState . scenarios   p <- liftIO $ normalizeScenarioPath ss (si ^. scenarioPath)   gameState . currentScenarioPath .= Just p   gameState . scenarios . scenarioItemByPath p . _SISingle . _2 . scenarioStatus .= InProgress t 0 0-  scenarioToAppState scene userSeed toRun+  scenarioToAppState siPair userSeed toRun  -- | Extract the scenario which would come next in the menu from the --   currently selected scenario (if any).  Can return @Nothing@ if --   either we are not in the @NewGameMenu@, or the current scenario --   is the last among its siblings.-nextScenario :: Menu -> Maybe (Scenario, ScenarioInfo)+nextScenario :: Menu -> Maybe ScenarioInfoPair nextScenario = \case   NewGameMenu (curMenu :| _) ->     let nextMenuList = BL.listMoveDown curMenu@@ -968,13 +993,26 @@           else BL.listSelectedElement nextMenuList >>= preview _SISingle . snd   _ -> Nothing +-- | Context for the REPL commands to execute in. Contains the base+--   robot context plus the `it` variable that refer to the previously+--   computed values. (Note that `it{n}` variables are set in the+--   base robot context; we only set `it` here because it's so transient)+topContext :: AppState -> RobotContext+topContext s = ctxPossiblyWithIt+ where+  ctx = fromMaybe emptyRobotContext $ s ^? gameState . baseRobot . robotContext++  ctxPossiblyWithIt = case s ^. gameState . replStatus of+    REPLDone (Just p) -> ctx & at "it" ?~ p+    _ -> ctx+ -- XXX do we need to keep an old entity map around???  -- | Modify the 'AppState' appropriately when starting a new scenario.-scenarioToAppState :: (MonadIO m, MonadState AppState m) => Scenario -> Maybe Seed -> Maybe String -> m ()-scenarioToAppState scene userSeed toRun = do+scenarioToAppState :: (MonadIO m, MonadState AppState m) => ScenarioInfoPair -> Maybe Seed -> Maybe CodeToRun -> m ()+scenarioToAppState siPair@(scene, _) userSeed toRun = do   withLensIO gameState $ scenarioToGameState scene userSeed toRun-  withLensIO uiState $ scenarioToUIState scene+  withLensIO uiState $ scenarioToUIState siPair  where   withLensIO :: (MonadIO m, MonadState AppState m) => Lens' AppState x -> (x -> IO x) -> m ()   withLensIO l a = do@@ -983,16 +1021,18 @@     l .= x'  -- | Modify the UI state appropriately when starting a new scenario.-scenarioToUIState :: Scenario -> UIState -> IO UIState-scenarioToUIState _scene u =+scenarioToUIState :: ScenarioInfoPair -> UIState -> IO UIState+scenarioToUIState siPair u =   return $     u       & uiPlaying .~ True       & uiGoal .~ Nothing       & uiFocusRing .~ initFocusRing       & uiInventory .~ Nothing+      & uiInventorySort .~ defaultSortOptions       & uiShowFPS .~ False       & uiShowZero .~ True       & lgTicksPerSecond .~ initLgTicksPerSecond-      & resetWithREPLForm (mkReplForm $ mkCmdPrompt "")-      & uiReplHistory %~ restartREPLHistory+      & uiREPL .~ initREPLState (u ^. uiREPL . replHistory)+      & uiREPL . replHistory %~ restartREPLHistory+      & scenarioRef ?~ siPair

@@ -44,6 +44,7 @@ import Brick.Widgets.Border (hBorder, hBorderWithLabel, joinableBorder, vBorder) import Brick.Widgets.Center (center, centerLayer, hCenter) import Brick.Widgets.Dialog+import Brick.Widgets.Edit (getEditContents, renderEditor) import Brick.Widgets.List qualified as BL import Brick.Widgets.Table qualified as BT import Control.Lens hiding (Const, from)@@ -63,7 +64,7 @@ import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList) import Data.Semigroup (sconcat) import Data.Sequence qualified as Seq-import Data.String (fromString)+import Data.Set qualified as Set (toList) import Data.Text (Text) import Data.Text qualified as T import Data.Time (NominalDiffTime, defaultTimeLocale, formatTime)@@ -93,6 +94,7 @@ import Swarm.Language.Types (Polytype) import Swarm.TUI.Attr import Swarm.TUI.Border+import Swarm.TUI.Inventory.Sorting (renderSortMethod) import Swarm.TUI.Model import Swarm.TUI.Panel import Swarm.Util@@ -174,7 +176,7 @@       , padLeft (Pad 5) (maybe (txt "") (drawDescription . snd) (BL.listSelectedElement l))       ]  where-  drawScenarioItem (SISingle s si) = padRight (Pad 1) (drawStatusInfo s si) <+> txt (s ^. scenarioName)+  drawScenarioItem (SISingle (s, si)) = padRight (Pad 1) (drawStatusInfo s si) <+> txt (s ^. scenarioName)   drawScenarioItem (SICollection nm _) = padRight (Pad 1) (withAttr boldAttr $ txt " > ") <+> txt nm   drawStatusInfo s si = case si ^. scenarioBestTime of     NotStarted -> txt " ○ "@@ -212,7 +214,7 @@    drawDescription :: ScenarioItem -> Widget Name   drawDescription (SICollection _ _) = txtWrap " "-  drawDescription (SISingle s si) = do+  drawDescription (SISingle (s, si)) = do     let oneBest = si ^. scenarioBestTime == si ^. scenarioBestTicks     let bestRealTime = if oneBest then "best:" else "best real time:"     let noSame = if oneBest then const Nothing else Just@@ -264,7 +266,7 @@ --   main layer and a layer for a floating dialog that can be on top. drawGameUI :: AppState -> [Widget Name] drawGameUI s =-  [ drawDialog s+  [ joinBorders $ drawDialog s   , joinBorders $       hBox         [ hLimitPercent 25 $@@ -293,7 +295,7 @@                     & addCursorPos                     & addClock                 )-                (drawWorld $ s ^. gameState)+                (drawWorld (s ^. uiState . uiShowRobots) (s ^. gameState))             , drawKeyMenu s             , clickable REPLPanel $                 panel@@ -301,7 +303,7 @@                   fr                   REPLPanel                   ( plainBorder-                      & topLabels . rightLabel .~ (drawType <$> (s ^. uiState . uiReplType))+                      & topLabels . rightLabel .~ (drawType <$> (s ^. uiState . uiREPL . replType))                   )                   ( vLimit replHeight                       . padBottom Max@@ -313,8 +315,10 @@   ]  where   addCursorPos = case s ^. uiState . uiWorldCursor of-    Just coord -> bottomLabels . leftLabel ?~ padLeftRight 1 (drawWorldCursorInfo (s ^. gameState) coord)     Nothing -> id+    Just coord ->+      let worlCursorInfo = drawWorldCursorInfo (s ^. uiState . uiShowRobots) (s ^. gameState) coord+       in bottomLabels . leftLabel ?~ padLeftRight 1 worlCursorInfo   -- Add clock display in top right of the world view if focused robot   -- has a clock installed   addClock = topLabels . rightLabel ?~ padLeftRight 1 (drawClockDisplay $ s ^. gameState)@@ -322,9 +326,9 @@   moreTop = s ^. uiState . uiMoreInfoTop   moreBot = s ^. uiState . uiMoreInfoBot -drawWorldCursorInfo :: GameState -> W.Coords -> Widget Name-drawWorldCursorInfo g i@(W.Coords (y, x)) =-  hBox [drawLoc g i, txt $ " at " <> from (show x) <> " " <> from (show (y * (-1)))]+drawWorldCursorInfo :: Bool -> GameState -> W.Coords -> Widget Name+drawWorldCursorInfo showRobots g i@(W.Coords (y, x)) =+  hBox [drawLoc showRobots g i, txt $ " at " <> from (show x) <> " " <> from (show (y * (-1)))]  -- | Format the clock display to be shown in the upper right of the --   world panel.@@ -444,18 +448,21 @@   DescriptionModal e -> descriptionWidget s e   QuitModal -> padBottom (Pad 1) $ hCenter $ txt (quitMsg (s ^. uiState . uiMenu))   GoalModal g -> padLeftRight 1 (displayParagraphs g)+  KeepPlayingModal -> padLeftRight 1 (displayParagraphs ["Have fun!  Hit Ctrl-Q whenever you're ready to proceed to the next challenge or return to the menu."])  quitMsg :: Menu -> Text-quitMsg m = "Are you sure you want to " <> quitAction <> "? All progress will be lost!"+quitMsg m = "Are you sure you want to " <> quitAction <> "? All progress on this scenario will be lost!"  where   quitAction = case m of     NoMenu -> "quit"-    _ -> "quit and return to the menu"+    _ -> "return to the menu"  -- | Generate a fresh modal window of the requested type. generateModal :: AppState -> ModalType -> Modal generateModal s mt = Modal mt (dialog (Just title) buttons (maxModalWindowWidth `min` requiredWidth))  where+  currentScenario = s ^. uiState . scenarioRef+  currentSeed = s ^. gameState . seed   haltingMessage = case s ^. uiState . uiMenu of     NoMenu -> Just "Quit"     _ -> Nothing@@ -479,20 +486,41 @@                   | Just scene <- [nextScenario (s ^. uiState . uiMenu)]                   ]                     ++ [ (stopMsg, QuitButton)-                       , (continueMsg, CancelButton)+                       , (continueMsg, KeepPlayingButton)                        ]                 )             , sum (map length [nextMsg, stopMsg, continueMsg]) + 32             )       DescriptionModal e -> (descriptionTitle e, Nothing, descriptionWidth)       QuitModal ->-        let stopMsg = fromMaybe "Quit to menu" haltingMessage+        let stopMsg = fromMaybe ("Quit to" ++ maybe "" (" " ++) (into @String <$> curMenuName s) ++ " menu") haltingMessage+            maybeStartOver = sequenceA ("Start over", StartOverButton currentSeed <$> currentScenario)          in ( ""-            , Just (0, [("Keep playing", CancelButton), (stopMsg, QuitButton)])+            , Just+                ( 0+                , catMaybes+                    [ Just ("Keep playing", CancelButton)+                    , maybeStartOver+                    , Just (stopMsg, QuitButton)+                    ]+                )             , T.length (quitMsg (s ^. uiState . uiMenu)) + 4             )-      GoalModal _ -> (" Goal ", Nothing, 80)+      GoalModal _ ->+        let goalModalTitle = case currentScenario of+              Nothing -> "Goal"+              Just (scenario, _) -> scenario ^. scenarioName+         in (" " <> T.unpack goalModalTitle <> " ", Nothing, 80)+      KeepPlayingModal -> ("", Just (0, [("OK", CancelButton)]), 80) +-- | Get the name of the current New Game menu.+curMenuName :: AppState -> Maybe Text+curMenuName s = case s ^. uiState . uiMenu of+  NewGameMenu (_ :| (parentMenu : _)) ->+    Just (parentMenu ^. BL.listSelectedElementL . to scenarioItemName)+  NewGameMenu _ -> Just "Scenarios"+  _ -> Nothing+ robotsListWidget :: AppState -> Widget Name robotsListWidget s = hCenter table  where@@ -544,7 +572,7 @@     locWidget = hBox [worldCell, txt $ " " <> locStr]      where       rloc@(V2 x y) = robot ^. robotLocation-      worldCell = drawLoc g (W.locToCoords rloc)+      worldCell = drawLoc (s ^. uiState . uiShowRobots) g (W.locToCoords rloc)       locStr = from (show x) <> " " <> from (show y)      statusWidget = case robot ^. machine of@@ -554,7 +582,7 @@         | otherwise -> withAttr greenAttr $ txt "idle"    basePos :: V2 Double-  basePos = realToFrac <$> fromMaybe (V2 0 0) (g ^? robotMap . ix 0 . robotLocation)+  basePos = realToFrac <$> fromMaybe (V2 0 0) (g ^? baseRobot . robotLocation)   -- Keep the base and non sytem robot (e.g. no seed)   isRelevant robot = robot ^. robotID == 0 || not (robot ^. systemRobot)   -- Keep the robot that are less than 32 unit away from the base@@ -613,7 +641,8 @@     , ("Ctrl-o", "single step")     , ("Ctrl-z", "decrease speed")     , ("Ctrl-w", "increase speed")-    , ("Ctrl-q", "quit the game")+    , ("Ctrl-q", "quit the current scenario")+    , ("Meta-h", "hide robots for 2s")     , ("Meta-w", "focus on the world map")     , ("Meta-e", "focus on the robot inventory")     , ("Meta-r", "focus on the REPL")@@ -703,7 +732,7 @@     | null (s ^. gameState . notifLens . notificationsContent) = Nothing     | otherwise =       let highlight-            | s ^. gameState . notifLens . notificationsCount > 0 = Highlighted+            | s ^. gameState . notifLens . notificationsCount > 0 = Alert             | otherwise = NoHighlight        in Just (highlight, key, name) @@ -728,7 +757,7 @@     . (++ [gameModeWidget])     . map (padLeftRight 1 . drawKeyCmd)     . (globalKeyCmds ++)-    . map (\(k, n) -> (NoHighlight, k, n))+    . map highlightKeyCmds     . keyCmdsFor     . focusGetCurrent     . view (uiState . uiFocusRing)@@ -743,6 +772,7 @@     Just g | g /= [] -> True     _ -> False   showZero = s ^. uiState . uiShowZero+  inventorySort = s ^. uiState . uiInventorySort    gameModeWidget =     padLeft Max . padLeftRight 1@@ -758,40 +788,55 @@       , Just (NoHighlight, "^p", if isPaused then "unpause" else "pause")       , Just (NoHighlight, "^o", "step")       , Just (NoHighlight, "^zx", "speed")+      , Just (if s ^. uiState . uiShowRobots then NoHighlight else Alert, "M-h", "hide robots")       ]   may b = if b then Just else const Nothing +  highlightKeyCmds (k, n) = (,k,n) $ case n of+    "pop out" | (s ^. uiState . uiMoreInfoBot) || (s ^. uiState . uiMoreInfoTop) -> Alert+    _ -> PanelSpecific+   keyCmdsFor (Just REPLPanel) =     [ ("↓↑", "history")     ]-      ++ [("Ret", "execute") | not isReplWorking]+      ++ [("Enter", "execute") | not isReplWorking]       ++ [("^c", "cancel") | isReplWorking]   keyCmdsFor (Just WorldPanel) =     [ ("←↓↑→ / hjkl", "scroll") | creative     ]       ++ [("c", "recenter") | not viewingBase]+      ++ [("f", "FPS")]   keyCmdsFor (Just RobotPanel) =-    [ ("Ret", "focus")+    [ ("Enter", "pop out")     , ("m", "make")     , ("0", (if showZero then "hide" else "show") <> " 0")+    , (":/;", T.unwords ["Sort:", renderSortMethod inventorySort])     ]   keyCmdsFor (Just InfoPanel) = []   keyCmdsFor _ = [] -data KeyHighlight = NoHighlight | Highlighted+data KeyHighlight = NoHighlight | Alert | PanelSpecific  -- | Draw a single key command in the menu. drawKeyCmd :: (KeyHighlight, Text, Text) -> Widget Name-drawKeyCmd (Highlighted, key, cmd) = hBox [withAttr notifAttr (txt $ T.concat ["[", key, "] "]), txt cmd]-drawKeyCmd (NoHighlight, key, cmd) = txt $ T.concat ["[", key, "] ", cmd]+drawKeyCmd (h, key, cmd) =+  hBox+    [ withAttr attr (txt $ T.concat ["[", key, "] "])+    , txt cmd+    ]+ where+  attr = case h of+    NoHighlight -> defAttr+    Alert -> notifAttr+    PanelSpecific -> highlightAttr  ------------------------------------------------------------ -- World panel ------------------------------------------------------------  -- | Draw the current world view.-drawWorld :: GameState -> Widget Name-drawWorld g =+drawWorld :: Bool -> GameState -> Widget Name+drawWorld showRobots g =   center     . cached WorldCache     . reportExtent WorldExtent@@ -803,21 +848,25 @@       let w = ctx ^. availWidthL           h = ctx ^. availHeightL           ixs = range (viewingRegion g (fromIntegral w, fromIntegral h))-      render . vBox . map hBox . chunksOf w . map (drawLoc g) $ ixs+      render . vBox . map hBox . chunksOf w . map (drawLoc showRobots g) $ ixs  -- | Render the 'Display' for a specific location.-drawLoc :: GameState -> W.Coords -> Widget Name-drawLoc g = renderDisplay . displayLoc g+drawLoc :: Bool -> GameState -> W.Coords -> Widget Name+drawLoc showRobots g = renderDisplay . displayLoc showRobots g  -- | Get the 'Display' for a specific location, by combining the --   'Display's for the terrain, entity, and robots at the location.-displayLoc :: GameState -> W.Coords -> Display-displayLoc g coords =-  sconcat . NE.fromList $-    [terrainMap M.! toEnum (W.lookupTerrain coords (g ^. world))]-      ++ maybeToList (displayForEntity <$> W.lookupEntity coords (g ^. world))-      ++ map (view robotDisplay) (robotsAtLocation (W.coordsToLoc coords) g)+displayLoc :: Bool -> GameState -> W.Coords -> Display+displayLoc showRobots g coords =+  sconcat $ terrain NE.:| entity <> robots  where+  terrain = terrainMap M.! toEnum (W.lookupTerrain coords (g ^. world))+  entity = maybeToList (displayForEntity <$> W.lookupEntity coords (g ^. world))+  robots =+    if showRobots+      then map (view robotDisplay) (robotsAtLocation (W.coordsToLoc coords) g)+      else []+   displayForEntity :: Entity -> Display   displayForEntity e = (if known e then id else hidden) (e ^. entityDisplay) @@ -919,7 +968,7 @@ explainEntry :: AppState -> Entity -> Widget Name explainEntry s e =   vBox-    [ displayProperties (e ^. entityProperties)+    [ displayProperties $ Set.toList (e ^. entityProperties)     , displayParagraphs (e ^. entityDescription)     , explainRecipes s e     ]@@ -1108,21 +1157,43 @@ -- REPL panel ------------------------------------------------------------ +-- | Turn the repl prompt into a decorator for the form+replPromptAsWidget :: Text -> REPLPrompt -> Widget Name+replPromptAsWidget _ (CmdPrompt _) = txt "> "+replPromptAsWidget t (SearchPrompt rh) =+  case lastEntry t rh of+    Nothing -> txt "[nothing found] "+    Just lastentry+      | T.null t -> txt "[find] "+      | otherwise -> txt $ "[found: \"" <> lastentry <> "\"] "++renderREPLPrompt :: FocusRing Name -> REPLState -> Widget Name+renderREPLPrompt focus repl = ps1 <+> replE+ where+  prompt = repl ^. replPromptType+  replEditor = repl ^. replPromptEditor+  color = if repl ^. replValid then id else withAttr redAttr+  ps1 = replPromptAsWidget (T.concat $ getEditContents replEditor) prompt+  replE =+    renderEditor+      (color . vBox . map txt)+      (focusGetCurrent focus `elem` [Nothing, Just REPLPanel, Just REPLInput])+      replEditor+ -- | Draw the REPL. drawREPL :: AppState -> Widget Name-drawREPL s =-  vBox $-    map fmt (getLatestREPLHistoryItems (replHeight - inputLines) history)-      ++ case isActive <$> base of-        Just False -> [renderForm (s ^. uiState . uiReplForm)]-        _ -> [padRight Max $ txt "..."]-      ++ [padRight Max $ txt histIdx | debugging]+drawREPL s = vBox $ latestHistory <> [currentPrompt]  where-  debugging = False -- Turn ON to get extra line with history index-  inputLines = 1 + fromEnum debugging-  history = s ^. uiState . uiReplHistory+  -- rendered history lines fitting above REPL prompt+  latestHistory :: [Widget n]+  latestHistory = map fmt (getLatestREPLHistoryItems (replHeight - inputLines) (repl ^. replHistory))+  currentPrompt :: Widget Name+  currentPrompt = case isActive <$> base of+    Just False -> renderREPLPrompt (s ^. uiState . uiFocusRing) repl+    _running -> padRight Max $ txt "..."+  inputLines = 1+  repl = s ^. uiState . uiREPL   base = s ^. gameState . robotMap . at 0-  histIdx = fromString $ show (history ^. replIndex)   fmt (REPLEntry e) = txt $ "> " <> e   fmt (REPLOutput t) = txt t 

@@ -1,5 +1,4 @@ {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}  -- | -- Module      :  Swarm.Version@@ -10,12 +9,6 @@ -- -- Query current and upstream Swarm version. module Swarm.Version (-  -- * Git info-  gitInfo,-  commitInfo,-  CommitHash,-  tagVersion,-   -- * PVP version   isSwarmReleaseTag,   version,@@ -29,17 +22,15 @@  import Control.Exception (catch, displayException) import Data.Aeson (Array, Value (..), (.:))-import Data.Bifunctor (first) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as BSL import Data.Char (isDigit) import Data.Either (lefts, rights) import Data.Foldable (toList)-import Data.List.Extra (breakOnEnd) import Data.Maybe (listToMaybe) import Data.Version (Version (..), parseVersion, showVersion) import Data.Yaml (ParseException, Parser, decodeEither', parseEither)-import GitHash (GitInfo, giBranch, giHash, giTag, tGitInfoCwdTry)+import GitHash (GitInfo, giBranch) import Network.HTTP.Client (   HttpException,   Request (requestHeaders),@@ -58,32 +49,12 @@ -- >>> import Data.Version (Version (..), parseVersion) -- >>> import Text.ParserCombinators.ReadP (readP_to_S) -gitInfo :: Either String GitInfo-gitInfo = $$tGitInfoCwdTry--commitInfo :: String-commitInfo = case gitInfo of-  Left _ -> ""-  Right git -> " (" <> giBranch git <> "@" <> take 10 (giHash git) <> ")"--type CommitHash = String- -- | Check that the tag follows the PVP versioning policy. -- -- Note that this filters out VS Code plugin releases. isSwarmReleaseTag :: String -> Bool isSwarmReleaseTag = all (\c -> isDigit c || c == '.') -tagVersion :: Maybe (CommitHash, String)-tagVersion = case gitInfo of-  Left _ -> Nothing-  Right gi ->-    let t = giTag gi-        ((ta, _num), ghash) = first (first init . breakOnEnd "-" . init) $ breakOnEnd "-" t-     in if isSwarmReleaseTag ta-          then Just (ghash, ta)-          else Nothing- version :: String version =   let v = showVersion Paths_swarm.version@@ -177,12 +148,12 @@ -- -- This function can fail if the current branch is not main, -- if there is no Internet connection or no newer release.-getNewerReleaseVersion :: IO (Either NewReleaseFailure String)-getNewerReleaseVersion =-  case gitInfo of+getNewerReleaseVersion :: Maybe GitInfo -> IO (Either NewReleaseFailure String)+getNewerReleaseVersion mgi =+  case mgi of     -- when using cabal install, the git info is unavailable, which is of no interest to players-    Left _e -> (>>= getUpVer) <$> upstreamReleaseVersion-    Right gi ->+    Nothing -> (>>= getUpVer) <$> upstreamReleaseVersion+    Just gi ->       if giBranch gi /= "main"         then return . Left . OnDevelopmentBranch $ giBranch gi         else (>>= getUpVer) <$> upstreamReleaseVersion

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               swarm-version:            0.1.1.0+version:            0.2.0.0 synopsis:           2D resource gathering game with programmable robots  description:        Swarm is a 2D programming and resource gathering@@ -18,7 +18,7 @@ bug-reports:        https://github.com/swarm-game/swarm/issues copyright:          Brent Yorgey 2021 category:           Game-tested-with:        GHC ==8.10.7 || ==9.0.2 || ==9.2.4+tested-with:        GHC ==8.10.7 || ==9.0.2 || ==9.2.4 || ==9.4.2 extra-source-files: CHANGELOG.md                     example/*.sw                     editors/emacs/*.el@@ -90,6 +90,7 @@                       Swarm.Language.Parse.QQ                       Swarm.Language.Pretty                       Swarm.Language.Typecheck+                      Swarm.Language.Typed                       Swarm.Language.Elaborate                       Swarm.Language.LSP                       Swarm.Language.Pipeline@@ -115,6 +116,7 @@                       Swarm.TUI.Model                       Swarm.TUI.View                       Swarm.TUI.Controller+                      Swarm.TUI.Inventory.Sorting                       Swarm.App                       Swarm.Version                       Swarm.Web@@ -124,10 +126,10 @@     other-modules:    Paths_swarm     autogen-modules:  Paths_swarm -    build-depends:    base                          >= 4.14 && < 4.17,-                      aeson                         >= 2 && < 2.1,+    build-depends:    base                          >= 4.14 && < 4.18,+                      aeson                         >= 2 && < 2.2,                       array                         >= 0.5.4 && < 0.6,-                      brick                         >= 1.0 && < 1.1,+                      brick                         >= 1.0 && < 1.4,                       bytestring                    >= 0.10 && < 0.12,                       clock                         >= 0.8.2 && < 0.9,                       containers                    >= 0.6.2 && < 0.7,@@ -144,13 +146,14 @@                       http-client                   >= 0.7 && < 0.8,                       http-client-tls               >= 0.3 && < 0.4,                       http-types                    >= 0.12 && < 0.13,-                      lens                          >= 4.19 && < 5.2,+                      lens                          >= 4.19 && < 5.3,                       linear                        >= 1.21.6 && < 1.22,-                      lsp                           >= 1.2 && < 1.5,+                      lsp                           >= 1.2 && < 1.7,                       megaparsec                    >= 9.0 && < 9.3,                       minimorph                     >= 0.3 && < 0.4,                       mtl                           >= 2.2.2 && < 2.3,                       murmur3                       >= 1.0.4 && < 1.1,+                      natural-sort                  >= 0.1.2 && < 0.2,                       parser-combinators            >= 1.2 && < 1.4,                       prettyprinter                 >= 1.7.0 && < 1.8,                       random                        >= 1.2.0 && < 1.3,@@ -160,23 +163,20 @@                       split                         >= 0.2.3 && < 0.3,                       stm                           >= 2.5.0 && < 2.6,                       syb                           >= 0.7 && < 0.8,-                      template-haskell              >= 2.16 && < 2.19,+                      tagged                        >= 0.8 && < 0.9,+                      template-haskell              >= 2.16 && < 2.20,                       text                          >= 1.2.4 && < 2.1,+                      text-zipper                   >= 0.10 && < 0.13,                       time                          >= 1.9 && < 1.14,                       unification-fd                >= 0.11  && < 0.12,                       unordered-containers          >= 0.2.14 && < 0.3,-                      vector                        >= 0.12 && < 0.13,-                      vty                           >= 5.33 && < 5.37,+                      vector                        >= 0.12 && < 0.14,+                      vty                           >= 5.33 && < 5.38,                       wai                           >= 3.2 && < 3.3,                       warp                          >= 3.2 && < 3.4,-                      witch                         >= 0.3.4 && < 1.1,+                      witch                         >= 1.1.1.0 && < 1.2,                       word-wrap                     >= 0.5 && < 0.6,                       yaml                          >= 0.11 && < 0.12,--                      -- Temporary workaround for TomMD/entropy#75.-                      -- We should be able to remove this bound once-                      -- it is fixed.-                      entropy                       <= 0.4.1.7,     hs-source-dirs:   src     default-language: Haskell2010     default-extensions:

@@ -29,6 +29,7 @@   GameState,   WinCondition (Won),   activeRobots,+  baseRobot,   initGameStateForScenario,   messageQueue,   robotMap,@@ -198,8 +199,7 @@         , testSolution Default "Testing/479-atomic-race"         , testSolution (Sec 5) "Testing/479-atomic"         , testSolution Default "Testing/555-teleport-location"-        , expectFailBecause "Awaiting fix (#540)" $-            testSolution (Sec 10) "Testing/562-lodestone"+        , testSolution Default "Testing/562-lodestone"         , testSolution Default "Testing/378-objectives"         , testSolution Default "Testing/684-swap"         , testSolution Default "Testing/699-movement-fail/699-move-blocked"@@ -221,7 +221,7 @@     case gs ^. winSolution of       Nothing -> assertFailure "No solution to test!"       Just sol -> do-        let gs' = gs & robotMap . ix 0 . machine .~ initMachine sol Ctx.empty emptyStore+        let gs' = gs & baseRobot . machine .~ initMachine sol Ctx.empty emptyStore         m <- timeout (time s) (snd <$> runStateT playUntilWin gs')         case m of           Nothing -> assertFailure "Timed out - this likely means that the solution did not work."

@@ -10,6 +10,8 @@ import Data.Text qualified as T import Data.Text.Encoding qualified as T import Swarm.Language.Pipeline (processTerm)+import Swarm.Language.Typecheck (isSimpleUType)+import Swarm.Language.Types import Test.Tasty import Test.Tasty.HUnit import Witch (from)@@ -232,6 +234,16 @@         , testCase             "invalid hex literal"             (process "0xabcD6G2" "1:8:\n  |\n1 | 0xabcD6G2\n  |        ^\nunexpected 'G'\n")+        ]+    , testGroup+        "void type"+        [ testCase+            "void - isSimpleUType"+            ( assertBool "" $ isSimpleUType UTyVoid+            )+        , testCase+            "void - valid type signature"+            (valid "def f : void -> a = \\x. undefined end")         ]     ]  where

@@ -5,6 +5,7 @@  import Swarm.Language.Pretty import Swarm.Language.Syntax hiding (mkOp)+import Swarm.Language.Types import Test.Tasty import Test.Tasty.HUnit @@ -76,6 +77,10 @@         "pairs #225 - nested pairs are printed right-associative"         ( equalPretty "(1, 2, 3)" $             TPair (TInt 1) (TPair (TInt 2) (TInt 3))+        )+    , testCase+        "void type"+        ( assertEqual "" "void" . show $ ppr TyVoid         )     ]  where