wip

data/schema/entity-count.json

@@ -0,0 +1,17 @@
+{
+    "$schema": "http://json-schema.org/draft-07/schema#",
+    "$id": "https://raw.githubusercontent.com/swarm-game/swarm/main/data/schema/entity-count.json",
+    "title": "Entity count",
+    "description": "One row in an inventory list",
+    "type": "array",
+    "items": [
+        {
+            "name": "Quantity",
+            "type": "number"
+        },
+        {
+            "name": "Entity name",
+            "type": "string"
+        }
+    ]
+}

data/schema/entity.json

@@ -20,7 +20,7 @@
             "description": "Display information for the entity."
         },
         "plural": {
-            "default": "null",
+            "default": null,
             "type": "string",
             "description": "An explicit plural form of the name of the entity. If omitted, standard heuristics will be used for forming the English plural of its name."
         },
@@ -32,7 +32,7 @@
             "description": "A description of the entity, as a list of paragraphs."
         },
         "orientation": {
-            "default": "null",
+            "default": null,
             "type": "array",
             "items": [
                 {
@@ -47,7 +47,7 @@
             "description": "A 2-tuple of integers specifying an orientation vector for the entity. Currently unused."
         },
         "growth": {
-            "default": "null",
+            "default": null,
             "type": "array",
             "items": [
                 {
@@ -67,7 +67,7 @@
             "description": "Properties of combustion."
         },
         "yields": {
-            "default": "null",
+            "default": null,
             "type": "string",
             "description": "The name of the entity which will be added to a robot's inventory when it executes grab or harvest on this entity. If omitted, the entity will simply yield itself."
         },

data/schema/inventory.json

@@ -5,16 +5,6 @@
     "description": "A list of `[count, entity name]` pairs, specifying the number of each entity.",
     "type": "array",
     "items": {
-        "type": "array",
-        "items": [
-            {
-                "title": "Entity count",
-                "type": "number"
-            },
-            {
-                "title": "Entity name",
-                "type": "string"
-            }
-        ]
+        "$ref": "entity-count.json"
     }
 }

data/schema/world.json

@@ -57,10 +57,9 @@
             "description": "Whether players are allowed to scroll the world map."
         },
         "palette": {
-            "default": {},
             "type": "object",
             "examples": [{"T": ["grass", "tree"]}],
-            "description": "The palette maps single character keys to tuples representing contents of cells in the world, so that a world containing entities and robots can be drawn graphically. See Cells for the contents of the tuples representing a cell."
+            "description": "The palette maps single character keys to tuples representing contents of cells in the world, so that a world containing entities and robots can be drawn graphically. See [Cells](#cells) for the contents of the tuples representing a cell."
         },
         "portals": {
             "description": "A list of portal definitions that reference waypoints.",

src/Swarm/Doc/Gen.hs

@@ -43,6 +43,7 @@ import Data.Text.IO qualified as T
 import Data.Tuple (swap)
 import Swarm.Doc.Pedagogy
 import Swarm.Doc.Schema.Render
+import Swarm.Doc.Util
 import Swarm.Game.Display (displayChar)
 import Swarm.Game.Entity (Entity, EntityMap (entitiesByName), entityDisplay, entityName, loadEntities)
 import Swarm.Game.Entity qualified as E
@@ -225,12 +226,6 @@ generateSpecialKeyNames =
 -- GENERATE TABLES: COMMANDS, ENTITIES AND CAPABILITIES TO MARKDOWN TABLE
 -- ----------------------------------------------------------------------------
 
-wrap :: Char -> Text -> Text
-wrap c = T.cons c . flip T.snoc c
-
-codeQuote :: Text -> Text
-codeQuote = wrap '`'
-
 escapeTable :: Text -> Text
 escapeTable = T.concatMap (\c -> if c == '|' then T.snoc "\\" c else T.singleton c)
 
@@ -245,12 +240,6 @@ 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
 -- ---------

src/Swarm/Doc/Schema/Arrangement.hs

@@ -3,12 +3,13 @@
 --
 -- Graph-based heuristics for arranging the
 -- order of sections in the schema docs
-module Swarm.Doc.Schema.Arrangement (mkSchemaGraph) where
+module Swarm.Doc.Schema.Arrangement (sortAndPruneSchemas) where
 
 import Data.Graph
 import Data.Set qualified as Set
 import Swarm.Doc.Schema.Parse
 import Swarm.Doc.Schema.Refined
+import Swarm.Doc.Schema.SchemaType
 
 -- | Sort the schemas in topological order.
 --
@@ -17,18 +18,16 @@ import Swarm.Doc.Schema.Refined
 -- (i.e. exclude @entities.json@ and @recipes.json@,
 -- which are used independently to validate @entities.yaml@
 -- and @recipes.yaml@).
-mkSchemaGraph ::
+sortAndPruneSchemas ::
   SchemaIdReference ->
   [SchemaData] ->
   [SchemaData]
-mkSchemaGraph rootSchemaKey schemas =
+sortAndPruneSchemas rootSchemaKey schemas =
   reverse . flattenSCCs . stronglyConnComp $ reachableEdges
  where
   rawEdgeList = map getNodeEdgesEntry schemas
   (graph, _nodeFromVertex, vertexFromKey) = graphFromEdges rawEdgeList
-
-  scenarioVertex = vertexFromKey rootSchemaKey
-  reachableVertices = Set.fromList $ maybe [] (reachable graph) scenarioVertex
+  reachableVertices = Set.fromList $ maybe [] (reachable graph) $ vertexFromKey rootSchemaKey
 
   reachableEdges = filter f rawEdgeList
   f (_, k, _) = maybe False (`Set.member` reachableVertices) . vertexFromKey $ k

src/Swarm/Doc/Schema/Parse.hs

@@ -11,17 +11,12 @@ module Swarm.Doc.Schema.Parse where
 
 import Control.Applicative ((<|>))
 import Data.Aeson
-import Data.List.Extra (replace)
 import Data.Map (Map)
-import Data.Map qualified as M
-import Data.Maybe (fromMaybe, mapMaybe)
-import Data.Set (Set)
-import Data.Set qualified as Set
+import Data.Maybe (fromMaybe)
 import Data.Text (Text)
-import Data.Text qualified as T
-import GHC.Generics (Generic)
 import Swarm.Doc.Schema.Refined
-import System.FilePath (takeBaseName)
+import Swarm.Doc.Schema.SchemaType
+import Swarm.Doc.Schema.Superset
 import Text.Pandoc
 
 -- | Includes everything needed to
@@ -32,48 +27,17 @@ data SchemaData = SchemaData
   , markdownFooters :: [Pandoc]
   }
 
-schemaJsonOptions :: Options
-schemaJsonOptions =
-  defaultOptions
-    { fieldLabelModifier = replace "S" "$" . tail -- drops leading underscore
-    }
-
-data ItemDescription
-  = ItemList [SwarmSchema]
-  | ItemType SwarmSchema
+data Members
+  = ObjectProperties (Map Text SwarmSchema)
+  | ListMembers (ItemDescription SwarmSchema)
+  | SimpleType (SingleOrList Text) -- TODO: Currently unused
   deriving (Eq, Ord, Show)
 
-instance FromJSON ItemDescription where
-  parseJSON x =
-    ItemType <$> parseJSON x
-      <|> ItemList <$> parseJSON x
-
-data SchemaRaw = SchemaRaw
-  { _description :: Maybe Text
-  , _default :: Maybe Value
-  , _title :: Maybe Text
-  , _type :: Maybe (SingleOrList Text)
-  , _properties :: Maybe (Map Text SwarmSchema)
-  , _items :: Maybe ItemDescription
-  , _examples :: Maybe [Value]
-  , _Sref :: Maybe Text
-  , _oneOf :: Maybe [SchemaRaw]
-  , _footers :: Maybe [FilePath]
-  }
-  deriving (Eq, Ord, Show, Generic)
-
-instance FromJSON SchemaRaw where
-  parseJSON = genericParseJSON schemaJsonOptions
-
--- | A subset of all JSON schemas, conforming to internal Swarm conventions.
---
--- TODO: Conveniently, this extra layer of processing
--- is able to enforce that all "object" definitions in the schema
--- contain the @additionalProperties: false@ property.
 data ToplevelSchema = ToplevelSchema
   { title :: Text
   , description :: Pandoc
   , content :: SwarmSchema
+  , members :: Maybe Members
   , footerPaths :: [FilePath]
   }
   deriving (Eq, Ord, Show)
@@ -86,71 +50,8 @@ instance FromJSON ToplevelSchema where
     theTitle <- maybe (fail "Schema requires a title") return $ _title rawSchema
     theDescription <- maybe (fail "Schema requires a description") return $ objectDescription swarmSchema
     let theFooters = fromMaybe [] $ _footers rawSchema
-    return $ ToplevelSchema theTitle theDescription swarmSchema theFooters
-
--- TODO use this to represent mutual-exclusivity
--- between objects and arrays
-data Members
-  = ObjectProperties (Map Text SwarmSchema)
-  | ListMembers [SwarmSchema]
-
-data SwarmSchema = SwarmSchema
-  { schemaType :: SchemaType
-  , defaultValue :: Maybe Value
-  , objectDescription :: Maybe Pandoc
-  , properties :: Maybe (Map Text SwarmSchema)
-  , examples :: [Value]
-  }
-  deriving (Eq, Ord, Show)
-
-instance FromJSON SwarmSchema where
-  parseJSON x = do
-    rawSchema :: rawSchema <- parseJSON x
-    toSwarmSchema rawSchema
-
-getMarkdown :: MonadFail m => Text -> m Pandoc
-getMarkdown desc = case runPure (readMarkdown def desc) of
-  Right doc -> return doc
-  Left err -> fail $ T.unpack $ renderError err
-
-extractSchemaType :: SchemaRaw -> Maybe SchemaType
-extractSchemaType rawSchema =
-  mkReference <$> _Sref rawSchema
-    <|> getTypeFromItems
-    <|> Simple <$> _type rawSchema
-    <|> Alternatives . mapMaybe extractSchemaType <$> _oneOf rawSchema
- where
-  mkReference = Reference . SchemaIdReference . T.pack . takeBaseName . T.unpack
-
-  getTypeFromItems :: Maybe SchemaType
-  getTypeFromItems = do
-    itemsThing <- _items rawSchema
-    case itemsThing of
-      ItemList _ -> Nothing
-      ItemType x -> Just $ ListOf $ schemaType x
-
-toSwarmSchema :: MonadFail m => SchemaRaw -> m SwarmSchema
-toSwarmSchema rawSchema = do
-  theType <- maybe (fail "Unspecified sub-schema type") return maybeType
-  markdownDescription <- mapM getMarkdown $ _description rawSchema
-  return
-    SwarmSchema
-      { schemaType = theType
-      , defaultValue = _default rawSchema
-      , objectDescription = markdownDescription
-      , examples = fromMaybe [] $ _examples rawSchema
-      , properties = _properties rawSchema
-      }
- where
-  maybeType = extractSchemaType rawSchema
-
--- * Utilities
-
--- | Recursively extract references to other schemas
-extractReferences :: SwarmSchema -> Set SchemaIdReference
-extractReferences s = thisRefList <> otherRefLists
- where
-  thisRefList = Set.fromList . getSchemaReferences $ schemaType s
 
-  otherSchemas = maybe [] M.elems (properties s)
-  otherRefLists = Set.unions $ map extractReferences otherSchemas
+    let maybeMembers =
+          ObjectProperties <$> properties swarmSchema
+            <|> ListMembers <$> itemsDescription swarmSchema
+    return $ ToplevelSchema theTitle theDescription swarmSchema maybeMembers theFooters