diff --git a/app/Main.hs b/app/Main.hs index b3768f1c9b..abb85c8a1d 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -103,6 +103,7 @@ cliParser = , 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)") + , Just Scenario <$ switch (long "scenario" <> help "Generate scenario schema page") ] seed :: Parser (Maybe Int) seed = optional $ option auto (long "seed" <> short 's' <> metavar "INT" <> help "Seed to use for world generation") diff --git a/data/schema/display.json b/data/schema/display.json index 66ba4c8709..94c93c0a3d 100644 --- a/data/schema/display.json +++ b/data/schema/display.json @@ -2,7 +2,7 @@ "$schema": "http://json-schema.org/draft-07/schema#", "$id": "https://raw.githubusercontent.com/swarm-game/swarm/main/data/schema/display.json", "title": "Swarm entity display", - "description": "How to display an entity or robot in the Swarm game", + "description": "A display specifies how an entity or a robot (robots are essentially special kinds of entities) is displayed in the world. It consists of a key-value mapping described by the following table.", "type": "object", "properties": { "char": { diff --git a/src/Swarm/Doc/Gen.hs b/src/Swarm/Doc/Gen.hs index cd8f813c55..0090156efc 100644 --- a/src/Swarm/Doc/Gen.hs +++ b/src/Swarm/Doc/Gen.hs @@ -42,6 +42,7 @@ import Data.Text qualified as T import Data.Text.IO qualified as T import Data.Tuple (swap) import Swarm.Doc.Pedagogy +import Swarm.Doc.Scenario import Swarm.Game.Display (displayChar) import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities) import Swarm.Game.Entity qualified as E @@ -88,7 +89,7 @@ data GenerateDocs where data EditorType = Emacs | VSCode deriving (Eq, Show, Enum, Bounded) -data SheetType = Entities | Commands | Capabilities | Recipes +data SheetType = Entities | Commands | Capabilities | Recipes | Scenario deriving (Eq, Show, Enum, Bounded) data PageAddress = PageAddress @@ -131,6 +132,7 @@ generateDocs = \case entities <- loadEntities recipes <- loadRecipes entities sendIO $ T.putStrLn $ recipePage address recipes + Scenario -> genScenarioSchemaDocs TutorialCoverage -> renderTutorialProgression >>= putStrLn . T.unpack -- ---------------------------------------------------------------------------- diff --git a/src/Swarm/Doc/Scenario.hs b/src/Swarm/Doc/Scenario.hs new file mode 100644 index 0000000000..450cd20690 --- /dev/null +++ b/src/Swarm/Doc/Scenario.hs @@ -0,0 +1,82 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- Render a markdown document fragment +-- from the Scenario JSON schema files. +module Swarm.Doc.Scenario where + +import Control.Applicative ((<|>)) +import Control.Arrow (left, (&&&)) +import Data.Aeson +import Data.Map.Strict qualified as M +import Data.Maybe (fromMaybe) +import Data.Text qualified as T +import Swarm.Doc.Schema +import Swarm.Util (quote, showT) +import System.FilePath ((<.>), ()) +import Text.Pandoc +import Text.Pandoc.Builder + +scenariosDir :: FilePath +scenariosDir = "data/scenarios" + +schemasDir :: FilePath +schemasDir = "data/schema" + +inputFiles :: [FilePath] +inputFiles = + [ "scenario" + , "combustion" + , "display" + , "world" + ] + +columnHeadings :: [T.Text] +columnHeadings = + [ "Key" + , "Default?" + , "Type" + , "Description" + ] + +makePandocTable :: (String, Schema) -> Pandoc +makePandocTable (fn, schm) = + setTitle (text "JSON Schema for Scenarios") $ + doc $ + header 3 (text $ T.toTitle $ T.pack fn) <> para (text $ description schm) <> myTable + where + genRow :: (T.Text, Prop) -> [Blocks] + genRow (k, x) = + [ plain $ code k + , maybe mempty (plain . code . renderValue) $ _default x + , plain . code . fromMaybe "" $ _type x <|> _Sref x + , plain . text . fromMaybe "" $ _description x <|> _Sref x + ] + + headerRow = map (plain . text) columnHeadings + myTable = simpleTable headerRow . map genRow . M.toList $ properties schm + +genScenarioSchemaDocs :: IO () +genScenarioSchemaDocs = do + xs <- mapM (sequenceA . (id &&& eitherDecodeFileStrict . makeSchemaPath)) inputFiles + let eitherMarkdown = do + schemas <- left T.pack $ traverse sequenceA xs + let pd = mconcat $ map makePandocTable schemas + left renderError $ runPure (writeMarkdown (def {writerExtensions = extensionsFromList [Ext_pipe_tables]}) pd) + + case eitherMarkdown of + Left e -> print $ unwords ["Failed:", T.unpack e] + Right md -> writeFile (scenariosDir "README_NEW.md") $ T.unpack md + where + makeSchemaPath bareName = schemasDir bareName <.> "json" + +renderValue :: Value -> T.Text +renderValue = \case + Object obj -> showT obj + Array arr -> showT arr + String t -> quote t + Number num -> showT num + Bool b -> showT b + Null -> "null" diff --git a/src/Swarm/Doc/Schema.hs b/src/Swarm/Doc/Schema.hs new file mode 100644 index 0000000000..4cfb6c802f --- /dev/null +++ b/src/Swarm/Doc/Schema.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DuplicateRecordFields #-} + +-- | +-- SPDX-License-Identifier: BSD-3-Clause +-- +-- There are no modern, comprehensive, JSON Schema parsing +-- libraries in Haskell, as explained in this post: +-- https://dev.to/sshine/a-review-of-json-schema-libraries-for-haskell-321 +-- +-- Therefore, a parser for a small, custom subset of JSON Schema is implemented here, +-- simply for rendering Markdown documentation from Swarm's schema. +module Swarm.Doc.Schema where + +import Data.Aeson +import Data.List.Extra (replace) +import Data.Map (Map) +import Data.Text (Text) +import GHC.Generics (Generic) + +data ArrayItem = ArrayItem + { _Aname :: Maybe Text + , _Atype :: Text + } + deriving (Eq, Ord, Show, Generic) + +instance FromJSON ArrayItem where + parseJSON = + genericParseJSON + defaultOptions + { fieldLabelModifier = drop 2 + } + +schemaJsonOptions :: Options +schemaJsonOptions = + defaultOptions + { fieldLabelModifier = replace "S" "$" . tail -- drops leading underscore + } + +data Prop = Prop + { _default :: Maybe Value + , _items :: Maybe Value + , _description :: Maybe Text + , _type :: Maybe Text + , _examples :: Maybe [Value] + , _Sref :: Maybe Text + } + deriving (Eq, Ord, Show, Generic) + +instance FromJSON Prop where + parseJSON = genericParseJSON schemaJsonOptions + +data Schema = Schema + { description :: Text + , title :: Text + , properties :: Map Text Prop + } + deriving (Eq, Ord, Show, Generic, FromJSON) diff --git a/swarm.cabal b/swarm.cabal index 7a6c5b636d..d8e90280b7 100644 --- a/swarm.cabal +++ b/swarm.cabal @@ -87,6 +87,8 @@ library Swarm.Constant Swarm.Doc.Gen Swarm.Doc.Pedagogy + Swarm.Doc.Scenario + Swarm.Doc.Schema Swarm.Game.Failure Swarm.Game.Achievement.Attainment Swarm.Game.Achievement.Definitions @@ -241,6 +243,8 @@ library minimorph >= 0.3 && < 0.4, transformers >= 0.5 && < 0.7, mtl >= 2.2.2 && < 2.4, + pandoc >= 3.0 && < 3.2, + pandoc-types >= 1.23 && < 1.24, murmur3 >= 1.0.4 && < 1.1, natural-sort >= 0.1.2 && < 0.2, parser-combinators >= 1.2 && < 1.4,