Generate editor keywords

xsebek · xsebek · commit 877412616abd · 2022-07-01T20:36:17.000+02:00
- part of #344
diff --git a/app/Main.hs b/app/Main.hs
@@ -3,18 +3,16 @@
 
 module Main where
 
-import Data.Text (
-  Text,
-  pack,
- )
+import Data.Foldable qualified
+import Data.Text (Text, pack)
 import Data.Text.IO qualified as Text
-import GitHash
+import GitHash (giBranch, giHash, tGitInfoCwdTry)
 import Options.Applicative
 import Swarm.App (appMain)
-import Swarm.DocGen (GenerateDocs (..), generateDocs)
+import Swarm.DocGen (EditorType (..), GenerateDocs (..), generateDocs)
 import Swarm.Language.LSP (lspMain)
 import Swarm.Language.Pipeline (processTerm)
-import System.Exit
+import System.Exit (exitFailure, exitSuccess)
 
 data CLI
   = Run
@@ -29,9 +27,11 @@ data CLI
 cliParser :: Parser CLI
 cliParser =
   subparser
-    ( command "format" (info (format <**> helper) (progDesc "Format a file"))
-        <> command "lsp" (info (pure LSP) (progDesc "Start the LSP"))
-        <> command "generate" (info (DocGen <$> docgen <**> helper) (progDesc "Generate docs"))
+    ( mconcat
+        [ command "format" (info (format <**> helper) (progDesc "Format a file"))
+        , command "lsp" (info (pure LSP) (progDesc "Start the LSP"))
+        , command "generate" (info (DocGen <$> docgen <**> helper) (progDesc "Generate docs"))
+        ]
     )
     <|> Run <$> seed <*> scenario <*> run <*> cheat
  where
@@ -41,8 +41,17 @@ cliParser =
       <|> (Format . File <$> strArgument (metavar "FILE"))
   docgen :: Parser GenerateDocs
   docgen =
-    subparser
-      (command "recipes" (info (pure RecipeGraph) $ progDesc "Output graphviz dotfile of entity dependencies based on recipes"))
+    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")
+      ]
+  editor :: Parser (Maybe EditorType)
+  editor =
+    Data.Foldable.asum
+      [ pure Nothing
+      , Just VSCode <$ switch (long "code" <> help "Generate for the VS Code editor")
+      , Just Emacs <$ switch (long "emacs" <> help "Generate for the Emacs editor")
+      ]
   seed :: Parser (Maybe Int)
   seed = optional $ option auto (long "seed" <> short 's' <> metavar "INT" <> help "Seed to use for world generation")
   scenario :: Parser (Maybe String)
diff --git a/editors/emacs/swarm-mode.el b/editors/emacs/swarm-mode.el
@@ -25,18 +25,74 @@
 
 (setq swarm-font-lock-keywords
       (let* (
-             ;; We should figure out how to autogenerate these, so we don't have
-             ;; to edit the emacs mode every time we add new commands.
+             ;; Generate the current keywords with:
+             ;; cabal run swarm:swarm -- generate editors --emacs
              (x-keywords '("def" "end"))
-             (x-builtins '("if" "run" "return" "try" "raise" "force" "fst" "snd"))
-             (x-commands
-              '("noop" "wait" "selfdestruct" "move" "turn" "grab" "place" "give"
-                "install" "make" "build" "salvage" "reprogram" "knows"
-                "say" "log" "view" "appear" "create" "getx" "gety"
-                "blocked" "scan" "upload" "ishere" "whoami"
-                "random" "not"
-                "left" "right" "back" "forward" "north" "south" "east" "west" "down"
-                ))
+             (x-builtins '(
+               "if"
+               "run"
+               "return"
+               "try"
+               "fail"
+               "force"
+               "fst"
+               "snd"
+             ))
+             (x-commands '(
+               "noop"
+               "wait"
+               "selfdestruct"
+               "move"
+               "turn"
+               "grab"
+               "harvest"
+               "place"
+               "give"
+               "install"
+               "make"
+               "has"
+               "count"
+               "drill"
+               "build"
+               "salvage"
+               "reprogram"
+               "say"
+               "log"
+               "view"
+               "appear"
+               "create"
+               "whereami"
+               "blocked"
+               "scan"
+               "upload"
+               "ishere"
+               "self"
+               "parent"
+               "base"
+               "whoami"
+               "setname"
+               "random"
+               "inl"
+               "inr"
+               "case"
+               "undefined"
+               "not"
+               "format"
+               "teleport"
+               "as"
+               "robotnamed"
+               "robotnumbered"
+               "knows"
+               "left"
+               "right"
+               "back"
+               "forward"
+               "north"
+               "south"
+               "east"
+               "west"
+               "down"
+             ))
              (x-types '("int" "string" "dir" "bool" "cmd"))
 
              (x-keywords-regexp (regexp-opt x-keywords 'words))
diff --git a/editors/vscode/DEVELOPING.md b/editors/vscode/DEVELOPING.md
@@ -29,17 +29,9 @@
 
 Whenever swarm language adds new features, the highlighing needs to be updated.
 
-To save some time, get the current reserved words by running `cabal repl`:
-```haskell
-import Swarm.Language.Syntax 
-import qualified Data.Text as T
-:set -XOverloadedStrings
-
--- get basic functions/commands
-T.intercalate  "|" $ map (syntax . constInfo) (filter isUserFunc allConst)
-
--- get list of directions
-T.intercalate "|" $  map (dirSyntax . dirInfo) allDirs
+To save some time, get the current reserved words by running `swarm generate`:
+```bash
+cabal run swarm:swarm -- generate editors
 ```
 
 You still have to add for example types manually.
diff --git a/editors/vscode/package.json b/editors/vscode/package.json
@@ -2,7 +2,7 @@
     "name": "swarm-language",
     "displayName": "swarm-language",
     "description": "VSCode support for swarm (the game) programming language.",
-    "version": "0.0.3",
+    "version": "0.0.4",
     "icon": "images/swarm-logo.png",
     "publisher": "xsebek",
     "repository": {
diff --git a/editors/vscode/syntaxes/swarm.tmLanguage.json b/editors/vscode/syntaxes/swarm.tmLanguage.json
@@ -47,7 +47,7 @@
 				},
 				{
 				"name": "keyword.operator",
-				"match": "(<|>|==|<=|>=|!=|=|;|<-|-|\\+|\\*|\\^|\\$|/(?![/|*]))"
+				"match": "-|==|!=|<|>|<=|>=|\\|\\||&&|\\+|-|\\*|/(?![/|*])|\\^|\\+\\+|\\$"
 				},
 				{
 				"name": "keyword.operator.lambda",
@@ -56,7 +56,7 @@
 				},
 				{
 				"name": "keyword.other",
-				"match": "\\b(?i)(noop|wait|selfdestruct|move|turn|grab|place|give|install|make|has|count|drill|build|salvage|reprogram|say|log|view|appear|create|whereami|blocked|scan|upload|ishere|whoami|random|run|if|inl|inr|case|fst|snd|force|return|try|raise|not)\\b"
+				"match": "\\b(?i)(noop|wait|selfdestruct|move|turn|grab|harvest|place|give|install|make|has|count|drill|build|salvage|reprogram|say|log|view|appear|create|whereami|blocked|scan|upload|ishere|self|parent|base|whoami|setname|random|run|if|inl|inr|case|fst|snd|force|return|try|undefined|fail|not|format|teleport|as|robotnamed|robotnumbered|knows)\\b"
 				}
 			]
 			},
diff --git a/src/Swarm/DocGen.hs b/src/Swarm/DocGen.hs
@@ -3,6 +3,14 @@
 module Swarm.DocGen (
   generateDocs,
   GenerateDocs (..),
+  EditorType (..),
+
+  -- ** Formatted keyword lists
+  keywordsCommands,
+  keywordsDirections,
+  operatorNames,
+  builtinCommandsListEmacs,
+  editorList,
 ) where
 
 import Control.Lens (view, (^.))
@@ -17,13 +25,17 @@ import Data.Maybe (fromMaybe)
 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 Swarm.Game.Entity qualified as E
 import Swarm.Game.Recipe (Recipe, loadRecipes, recipeInputs, recipeOutputs, recipeRequirements)
 import Swarm.Game.Robot (installedDevices, robotInventory, setRobotID)
 import Swarm.Game.Scenario (Scenario, loadScenario, scenarioRobots)
 import Swarm.Game.WorldGen (testWorld2Entites)
+import Swarm.Language.Syntax (Const (..), ConstMeta (..))
+import Swarm.Language.Syntax qualified as Syntax
 import Swarm.Util (isRightOr)
 import Text.Dot (Dot, NodeId, (.->.))
 import Text.Dot qualified as Dot
@@ -39,11 +51,88 @@ import Text.Dot qualified as Dot
 data GenerateDocs where
   -- | Entity dependencies by recipes.
   RecipeGraph :: GenerateDocs
+  -- | Keyword lists for editors.
+  EditorKeywords :: Maybe EditorType -> GenerateDocs
   deriving (Eq, Show)
 
+data EditorType = Emacs | VSCode
+  deriving (Eq, Show, Enum, Bounded)
+
 generateDocs :: GenerateDocs -> IO ()
 generateDocs = \case
   RecipeGraph -> generateRecipe >>= putStrLn
+  EditorKeywords e ->
+    case e of
+      Just et -> generateEditorKeywords et
+      Nothing -> do
+        putStrLn "All editor completions:"
+        let editorGen et = do
+              putStrLn $ replicate 40 '-'
+              putStrLn $ "-- " <> show et
+              putStrLn $ replicate 40 '-'
+              generateEditorKeywords et
+        mapM_ editorGen [minBound .. maxBound]
+
+-- ----------------------------------------------------------------------------
+-- GENERATE KEYWORDS: LIST OF WORDS TO BE HIGHLIGHTED
+-- ----------------------------------------------------------------------------
+
+generateEditorKeywords :: EditorType -> IO ()
+generateEditorKeywords = \case
+  Emacs -> do
+    putStrLn "(x-builtins '("
+    T.putStr . editorList Emacs $ map constSyntax builtinCommandsEmacs
+    putStrLn "))\n(x-commands '("
+    T.putStr $ keywordsCommands Emacs
+    T.putStr $ keywordsDirections Emacs
+    putStrLn "))"
+  VSCode -> do
+    putStrLn "Functions and commands:"
+    T.putStrLn $ keywordsCommands VSCode
+    putStrLn "\nDirections:"
+    T.putStrLn $ keywordsDirections VSCode
+    putStrLn "\nOperators:"
+    T.putStrLn operatorNames
+
+builtinCommandsEmacs :: [Const]
+builtinCommandsEmacs = [If, Run, Return, Try, Fail, Force, Fst, Snd]
+
+builtinCommandsListEmacs :: Text
+builtinCommandsListEmacs = editorList Emacs $ map constSyntax builtinCommandsEmacs
+
+editorList :: EditorType -> [Text] -> Text
+editorList = \case
+  Emacs -> T.unlines . map (("  " <>) . quote)
+  VSCode -> T.intercalate "|"
+ where
+  quote = T.cons '"' . flip T.snoc '"'
+
+constSyntax :: Const -> Text
+constSyntax = Syntax.syntax . Syntax.constInfo
+
+-- | Get formatted list of basic functions/commands.
+keywordsCommands :: EditorType -> Text
+keywordsCommands e = editorList e $ map constSyntax (filter isFunc Syntax.allConst)
+ where
+  isFunc c = Syntax.isUserFunc c && (e /= Emacs || c `notElem` builtinCommandsEmacs)
+
+-- | Get formatted list of directions.
+keywordsDirections :: EditorType -> Text
+keywordsDirections e = editorList e $ map (Syntax.dirSyntax . Syntax.dirInfo) Syntax.allDirs
+
+operatorNames :: Text
+operatorNames = T.intercalate "|" $ map (escape . constSyntax) (filter isOperator Syntax.allConst)
+ where
+  special :: String
+  special = "*+$[]|^"
+  slashNotComment = \case
+    '/' -> "/(?![/|*])"
+    c -> T.singleton c
+  escape = T.concatMap (\c -> if c `elem` special then T.snoc "\\\\" c else slashNotComment c)
+  isOperator c = case Syntax.constMeta $ Syntax.constInfo c of
+    ConstMUnOp {} -> True
+    ConstMBinOp {} -> True
+    ConstMFunc {} -> False
 
 -- ----------------------------------------------------------------------------
 -- GENERATE GRAPHVIZ: ENTITY DEPENDENCIES BY RECIPES
diff --git a/swarm.cabal b/swarm.cabal
@@ -21,6 +21,8 @@ category:           Game
 tested-with:        GHC ==8.10.7 || ==9.0.2 || ==9.2.3
 extra-source-files: CHANGELOG.md
                     example/*.sw
+                    editors/emacs/*.el
+                    editors/vscode/syntaxes/*.json
 data-dir:           data/
 data-files:         *.yaml, scenarios/**/*.yaml, scenarios/**/*.txt, scenarios/**/*.sw, *.txt
 
diff --git a/test/integration/Main.hs b/test/integration/Main.hs
@@ -9,14 +9,18 @@ import Control.Lens (Ixed (ix), to, use, view, (&), (.~), (<&>), (^.), (^?!))
 import Control.Monad (filterM, forM_, unless, void, when)
 import Control.Monad.State (StateT (runStateT), gets)
 import Control.Monad.Trans.Except (runExceptT)
+import Data.Char (isSpace)
 import Data.Containers.ListUtils (nubOrd)
 import Data.Foldable (Foldable (toList), find)
 import Data.IntSet qualified as IS
 import Data.Map qualified as M
 import Data.Maybe (isJust)
 import Data.Text (Text)
 import Data.Text qualified as T
+import Data.Text.IO qualified as T
 import Data.Yaml (ParseException, prettyPrintParseException)
+import Swarm.DocGen (EditorType (..))
+import Swarm.DocGen qualified as DocGen
 import Swarm.Game.CESK (emptyStore, initMachine)
 import Swarm.Game.Entity (EntityMap, loadEntities)
 import Swarm.Game.Robot (leText, machine, robotLog, waitingUntil)
@@ -62,6 +66,7 @@ main = do
           , exampleTests scenarioPrograms
           , scenarioTests em scenarioPaths
           , testScenarioSolution ci em
+          , testEditorFiles
           ]
 
 exampleTests :: [(FilePath, String)] -> TestTree
@@ -214,3 +219,38 @@ printAllLogs g =
   mapM_
     (\r -> forM_ (r ^. robotLog) (putStrLn . T.unpack . view leText))
     (g ^. robotMap)
+
+-- | Test that editor files are up-to-date.
+testEditorFiles :: TestTree
+testEditorFiles =
+  testGroup
+    "editors"
+    [ testGroup
+        "VS Code"
+        [ testTextInVSCode "operators" (const DocGen.operatorNames)
+        , testTextInVSCode "commands" DocGen.keywordsCommands
+        , testTextInVSCode "directions" DocGen.keywordsDirections
+        ]
+    , testGroup
+        "Emacs"
+        [ testTextInEmacs "builtin" (const DocGen.builtinCommandsListEmacs)
+        , testTextInEmacs "commands" DocGen.keywordsCommands
+        , testTextInEmacs "directions" DocGen.keywordsDirections
+        ]
+    ]
+ where
+  testTextInVSCode name tf = testTextInFile False name (tf VSCode) "editors/vscode/syntaxes/swarm.tmLanguage.json"
+  testTextInEmacs name tf = testTextInFile True name (tf Emacs) "editors/emacs/swarm-mode.el"
+  testTextInFile :: Bool -> String -> Text -> FilePath -> TestTree
+  testTextInFile whitespace name t fp = testCase name $ do
+    let removeLW' = T.unlines . map (T.dropWhile isSpace) . T.lines
+        removeLW = if whitespace then removeLW' else id
+    f <- T.readFile fp
+    assertBool
+      ( "EDITOR FILE IS NOT UP TO DATE!\n"
+          <> "I could not find the text:\n"
+          <> T.unpack t
+          <> "\nin file "
+          <> fp
+      )
+      (removeLW t `T.isInfixOf` removeLW f)

Original file line number	Diff line number	Diff line change
`@@ -47,7 +47,7 @@`
`47`	`47`	`},`
`48`	`48`	`{`
`49`	`49`	`"name": "keyword.operator",`
`50`		`- "match": "(<\|>\|==\|<=\|>=\|!=\|=\|;\|<-\|-\|\\+\|\\\|\\^\|\\$\|/(?![/\|]))"`
	`50`	`+ "match": "-\|==\|!=\|<\|>\|<=\|>=\|\\\|\\\|\|&&\|\\+\|-\|\\\|/(?![/\|])\|\\^\|\\+\\+\|\\$"`
`51`	`51`	`},`
`52`	`52`	`{`
`53`	`53`	`"name": "keyword.operator.lambda",`
`@@ -56,7 +56,7 @@`
`56`	`56`	`},`
`57`	`57`	`{`
`58`	`58`	`"name": "keyword.other",`
`59`		`- "match": "\\b(?i)(noop\|wait\|selfdestruct\|move\|turn\|grab\|place\|give\|install\|make\|has\|count\|drill\|build\|salvage\|reprogram\|say\|log\|view\|appear\|create\|whereami\|blocked\|scan\|upload\|ishere\|whoami\|random\|run\|if\|inl\|inr\|case\|fst\|snd\|force\|return\|try\|raise\|not)\\b"`
	`59`	`+ "match": "\\b(?i)(noop\|wait\|selfdestruct\|move\|turn\|grab\|harvest\|place\|give\|install\|make\|has\|count\|drill\|build\|salvage\|reprogram\|say\|log\|view\|appear\|create\|whereami\|blocked\|scan\|upload\|ishere\|self\|parent\|base\|whoami\|setname\|random\|run\|if\|inl\|inr\|case\|fst\|snd\|force\|return\|try\|undefined\|fail\|not\|format\|teleport\|as\|robotnamed\|robotnumbered\|knows)\\b"`
`60`	`60`	`}`
`61`	`61`	`]`
`62`	`62`	`},`