Skip to content

Commit

Permalink
fix schema renderer
Browse files Browse the repository at this point in the history
  • Loading branch information
kostmo committed May 6, 2024
1 parent a8087b7 commit ebe28c3
Show file tree
Hide file tree
Showing 5 changed files with 120 additions and 79 deletions.
3 changes: 3 additions & 0 deletions app/doc/Swarm/Doc/Schema/Parse.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module Swarm.Doc.Schema.Parse where

import Control.Applicative ((<|>))
import Data.Aeson
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
Expand All @@ -28,6 +29,7 @@ data SchemaData = SchemaData
data Members
= ObjectProperties (Map Text SwarmSchema)
| ListMembers (ItemDescription SwarmSchema)
| EnumMembers (NonEmpty Text)
deriving (Eq, Ord, Show)

data ToplevelSchema = ToplevelSchema
Expand All @@ -49,4 +51,5 @@ instance FromJSON ToplevelSchema where
maybeMembers =
ObjectProperties <$> properties swarmSchema
<|> ListMembers <$> itemsDescription swarmSchema
<|> EnumMembers <$> _enum rawSchema
return $ ToplevelSchema theTitle (objectDescription swarmSchema) swarmSchema maybeMembers theFooters
4 changes: 4 additions & 0 deletions app/doc/Swarm/Doc/Schema/Refined.hs
Original file line number Diff line number Diff line change
Expand Up @@ -11,6 +11,7 @@ module Swarm.Doc.Schema.Refined where
import Control.Applicative ((<|>))
import Data.Aeson
import Data.List.Extra (replace)
import Data.List.NonEmpty (NonEmpty)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Maybe (fromMaybe, mapMaybe)
Expand Down Expand Up @@ -47,6 +48,7 @@ data SchemaRaw = SchemaRaw
, _oneOf :: Maybe [SchemaRaw]
, _footers :: Maybe [FilePath]
, _additionalProperties :: Maybe Bool
, _enum :: Maybe (NonEmpty Text)
}
deriving (Eq, Ord, Show, Generic)

Expand All @@ -59,6 +61,7 @@ extractSchemaType rawSchema =
<|> getTypeFromItems
<|> Simple <$> _type rawSchema
<|> Alternatives . mapMaybe extractSchemaType <$> _oneOf rawSchema
<|> EnumList <$> _enum rawSchema
where
mkReference = Reference . SchemaIdReference . T.pack . takeBaseName . T.unpack

Expand Down Expand Up @@ -87,6 +90,7 @@ getSchemaReferences = \case
Alternatives xs -> concatMap getSchemaReferences xs
Reference x -> pure x
ListOf x -> getSchemaReferences x
EnumList _ -> []

-- | A subset of all JSON schemas, conforming to internal Swarm conventions.
--
Expand Down
6 changes: 6 additions & 0 deletions app/doc/Swarm/Doc/Schema/Render.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,7 @@ import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.Except (except)
import Data.Aeson
import Data.List (intersperse)
import Data.List.NonEmpty qualified as NE
import Data.Map (Map)
import Data.Map.Strict qualified as M
import Data.Maybe (fromMaybe)
Expand Down Expand Up @@ -81,6 +82,10 @@ makePandocTable titleMap (SchemaData _ (ToplevelSchema theTitle theDescription _
mkTable x = doc $ case x of
ObjectProperties props -> makePropsTable True propertyColumnHeadings titleMap props
ListMembers someStuff -> renderItems someStuff
EnumMembers enumMembers ->
simpleTable [plain $ text "Member"] $
map (\m -> [plain $ code m]) $
NE.toList enumMembers

genPropsRow :: Bool -> Map SchemaIdReference T.Text -> (T.Text, SwarmSchema) -> [Blocks]
genPropsRow includeDefaultColumn titleMap (k, x) =
Expand Down Expand Up @@ -176,6 +181,7 @@ listToText titleMap = \case
Alternatives xs -> renderAlternatives $ map (listToText titleMap) xs
Reference r@(SchemaIdReference x) -> schemaLink r x
ListOf x -> listToText titleMap x <> text " list"
EnumList xs -> renderAlternatives $ NE.toList $ text <$> xs
where
renderAlternatives = mconcat . intersperse (text " or ")
schemaLink r = link (fragmentHref titleMap r) "Link to object properties" . text
Expand Down
2 changes: 2 additions & 0 deletions app/doc/Swarm/Doc/Schema/SchemaType.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@ module Swarm.Doc.Schema.SchemaType where

import Control.Applicative ((<|>))
import Data.Aeson
import Data.List.NonEmpty (NonEmpty)
import Data.Text (Text)
import Data.Text qualified as T
import System.FilePath (takeBaseName)
Expand All @@ -29,6 +30,7 @@ data SchemaType
Reference SchemaIdReference
| -- | Members of a list, all of the given schema type
ListOf SchemaType
| EnumList (NonEmpty Text)
deriving (Eq, Ord, Show)

newtype SchemaIdReference = SchemaIdReference Text
Expand Down
Loading

0 comments on commit ebe28c3

Please sign in to comment.