Generate other wikis

app/Main.hs

@@ -4,12 +4,14 @@
 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 (..))
@@ -54,7 +56,7 @@ cliParser =
     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 =
@@ -63,6 +65,27 @@ cliParser =
       , 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)

src/Swarm/DocGen.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Swarm.DocGen (
   generateDocs,
@@ -14,39 +15,49 @@ module Swarm.DocGen (
   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 @@ data GenerateDocs where
   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 EditorType = Emacs | VSCode
 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 @@ generateDocs = \case
               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 @@ listToRow mw xs = wrap '|' . T.intercalate "|" $ zipWith format mw xs
 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 :: Const -> [Text]
 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 @@ commandToSection c =
     , ""
     , "- 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
     ]
@@ -229,6 +267,136 @@ commandsPage =
     ]
       <> 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
 -- ----------------------------------------------------------------------------