{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Refined JSON schema after converting
-- all JSON Value types to their specific sum types
module Swarm.Doc.Schema.Refined where

import Control.Applicative ((<|>))
import Control.Monad (unless)
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)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Text (Text)
import Data.Text qualified as T
import GHC.Generics (Generic)
import Swarm.Doc.Schema.SchemaType
import System.FilePath (takeBaseName)
import Text.Pandoc
import Text.Pandoc.Builder

-- * Basic

schemaJsonOptions :: Options
schemaJsonOptions :: Options
schemaJsonOptions =
  Options
defaultOptions
    { fieldLabelModifier = replace "S" "$" . drop 1 -- drops leading underscore
    }

-- | A single record that encompasses all possible objects
-- in a JSON schema. All fields are optional.
data SchemaRaw = SchemaRaw
  { SchemaRaw -> Maybe Text
_description :: Maybe Text
  , SchemaRaw -> Maybe Value
_default :: Maybe Value
  , SchemaRaw -> Maybe Text
_title :: Maybe Text
  , SchemaRaw -> Maybe (SingleOrList Text)
_type :: Maybe (SingleOrList Text)
  , SchemaRaw -> Maybe Text
_name :: Maybe Text
  , SchemaRaw -> Maybe (Map Text SwarmSchema)
_properties :: Maybe (Map Text SwarmSchema)
  , SchemaRaw -> Maybe (ItemDescription SwarmSchema)
_items :: Maybe (ItemDescription SwarmSchema)
  , SchemaRaw -> Maybe [Value]
_examples :: Maybe [Value]
  , SchemaRaw -> Maybe Text
_Sref :: Maybe Text
  , SchemaRaw -> Maybe [SchemaRaw]
_oneOf :: Maybe [SchemaRaw]
  , SchemaRaw -> Maybe [[Char]]
_footers :: Maybe [FilePath]
  , SchemaRaw -> Maybe Bool
_additionalProperties :: Maybe Bool
  , SchemaRaw -> Maybe (NonEmpty Text)
_enum :: Maybe (NonEmpty Text)
  }
  deriving (SchemaRaw -> SchemaRaw -> Bool
(SchemaRaw -> SchemaRaw -> Bool)
-> (SchemaRaw -> SchemaRaw -> Bool) -> Eq SchemaRaw
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SchemaRaw -> SchemaRaw -> Bool
== :: SchemaRaw -> SchemaRaw -> Bool
$c/= :: SchemaRaw -> SchemaRaw -> Bool
/= :: SchemaRaw -> SchemaRaw -> Bool
Eq, Eq SchemaRaw
Eq SchemaRaw =>
(SchemaRaw -> SchemaRaw -> Ordering)
-> (SchemaRaw -> SchemaRaw -> Bool)
-> (SchemaRaw -> SchemaRaw -> Bool)
-> (SchemaRaw -> SchemaRaw -> Bool)
-> (SchemaRaw -> SchemaRaw -> Bool)
-> (SchemaRaw -> SchemaRaw -> SchemaRaw)
-> (SchemaRaw -> SchemaRaw -> SchemaRaw)
-> Ord SchemaRaw
SchemaRaw -> SchemaRaw -> Bool
SchemaRaw -> SchemaRaw -> Ordering
SchemaRaw -> SchemaRaw -> SchemaRaw
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SchemaRaw -> SchemaRaw -> Ordering
compare :: SchemaRaw -> SchemaRaw -> Ordering
$c< :: SchemaRaw -> SchemaRaw -> Bool
< :: SchemaRaw -> SchemaRaw -> Bool
$c<= :: SchemaRaw -> SchemaRaw -> Bool
<= :: SchemaRaw -> SchemaRaw -> Bool
$c> :: SchemaRaw -> SchemaRaw -> Bool
> :: SchemaRaw -> SchemaRaw -> Bool
$c>= :: SchemaRaw -> SchemaRaw -> Bool
>= :: SchemaRaw -> SchemaRaw -> Bool
$cmax :: SchemaRaw -> SchemaRaw -> SchemaRaw
max :: SchemaRaw -> SchemaRaw -> SchemaRaw
$cmin :: SchemaRaw -> SchemaRaw -> SchemaRaw
min :: SchemaRaw -> SchemaRaw -> SchemaRaw
Ord, Int -> SchemaRaw -> [Char] -> [Char]
[SchemaRaw] -> [Char] -> [Char]
SchemaRaw -> [Char]
(Int -> SchemaRaw -> [Char] -> [Char])
-> (SchemaRaw -> [Char])
-> ([SchemaRaw] -> [Char] -> [Char])
-> Show SchemaRaw
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> SchemaRaw -> [Char] -> [Char]
showsPrec :: Int -> SchemaRaw -> [Char] -> [Char]
$cshow :: SchemaRaw -> [Char]
show :: SchemaRaw -> [Char]
$cshowList :: [SchemaRaw] -> [Char] -> [Char]
showList :: [SchemaRaw] -> [Char] -> [Char]
Show, (forall x. SchemaRaw -> Rep SchemaRaw x)
-> (forall x. Rep SchemaRaw x -> SchemaRaw) -> Generic SchemaRaw
forall x. Rep SchemaRaw x -> SchemaRaw
forall x. SchemaRaw -> Rep SchemaRaw x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SchemaRaw -> Rep SchemaRaw x
from :: forall x. SchemaRaw -> Rep SchemaRaw x
$cto :: forall x. Rep SchemaRaw x -> SchemaRaw
to :: forall x. Rep SchemaRaw x -> SchemaRaw
Generic)

instance FromJSON SchemaRaw where
  parseJSON :: Value -> Parser SchemaRaw
parseJSON = Options -> Value -> Parser SchemaRaw
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
schemaJsonOptions

extractSchemaType :: SchemaRaw -> Maybe SchemaType
extractSchemaType :: SchemaRaw -> Maybe SchemaType
extractSchemaType SchemaRaw
rawSchema =
  Text -> SchemaType
mkReference (Text -> SchemaType) -> Maybe Text -> Maybe SchemaType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaRaw -> Maybe Text
_Sref SchemaRaw
rawSchema
    Maybe SchemaType -> Maybe SchemaType -> Maybe SchemaType
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe SchemaType
getTypeFromItems
    Maybe SchemaType -> Maybe SchemaType -> Maybe SchemaType
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> SingleOrList Text -> SchemaType
Simple (SingleOrList Text -> SchemaType)
-> Maybe (SingleOrList Text) -> Maybe SchemaType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaRaw -> Maybe (SingleOrList Text)
_type SchemaRaw
rawSchema
    Maybe SchemaType -> Maybe SchemaType -> Maybe SchemaType
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [SchemaType] -> SchemaType
Alternatives ([SchemaType] -> SchemaType)
-> ([SchemaRaw] -> [SchemaType]) -> [SchemaRaw] -> SchemaType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaRaw -> Maybe SchemaType) -> [SchemaRaw] -> [SchemaType]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SchemaRaw -> Maybe SchemaType
extractSchemaType ([SchemaRaw] -> SchemaType)
-> Maybe [SchemaRaw] -> Maybe SchemaType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaRaw -> Maybe [SchemaRaw]
_oneOf SchemaRaw
rawSchema
    Maybe SchemaType -> Maybe SchemaType -> Maybe SchemaType
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NonEmpty Text -> SchemaType
EnumList (NonEmpty Text -> SchemaType)
-> Maybe (NonEmpty Text) -> Maybe SchemaType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaRaw -> Maybe (NonEmpty Text)
_enum SchemaRaw
rawSchema
 where
  mkReference :: Text -> SchemaType
mkReference = SchemaIdReference -> SchemaType
Reference (SchemaIdReference -> SchemaType)
-> (Text -> SchemaIdReference) -> Text -> SchemaType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SchemaIdReference
SchemaIdReference (Text -> SchemaIdReference)
-> (Text -> Text) -> Text -> SchemaIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
T.pack ([Char] -> Text) -> (Text -> [Char]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
takeBaseName ([Char] -> [Char]) -> (Text -> [Char]) -> Text -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
T.unpack

  getTypeFromItems :: Maybe SchemaType
  getTypeFromItems :: Maybe SchemaType
getTypeFromItems = do
    ItemDescription SwarmSchema
itemsThing <- SchemaRaw -> Maybe (ItemDescription SwarmSchema)
_items SchemaRaw
rawSchema
    case ItemDescription SwarmSchema
itemsThing of
      ItemList [SwarmSchema]
_ -> Maybe SchemaType
forall a. Maybe a
Nothing
      ItemType SwarmSchema
x -> SchemaType -> Maybe SchemaType
forall a. a -> Maybe a
Just (SchemaType -> Maybe SchemaType) -> SchemaType -> Maybe SchemaType
forall a b. (a -> b) -> a -> b
$ SchemaType -> SchemaType
ListOf (SchemaType -> SchemaType) -> SchemaType -> SchemaType
forall a b. (a -> b) -> a -> b
$ SwarmSchema -> SchemaType
schemaType SwarmSchema
x

-- * Refined

data ItemDescription a
  = ItemList [a]
  | ItemType a
  deriving (ItemDescription a -> ItemDescription a -> Bool
(ItemDescription a -> ItemDescription a -> Bool)
-> (ItemDescription a -> ItemDescription a -> Bool)
-> Eq (ItemDescription a)
forall a. Eq a => ItemDescription a -> ItemDescription a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ItemDescription a -> ItemDescription a -> Bool
== :: ItemDescription a -> ItemDescription a -> Bool
$c/= :: forall a. Eq a => ItemDescription a -> ItemDescription a -> Bool
/= :: ItemDescription a -> ItemDescription a -> Bool
Eq, Eq (ItemDescription a)
Eq (ItemDescription a) =>
(ItemDescription a -> ItemDescription a -> Ordering)
-> (ItemDescription a -> ItemDescription a -> Bool)
-> (ItemDescription a -> ItemDescription a -> Bool)
-> (ItemDescription a -> ItemDescription a -> Bool)
-> (ItemDescription a -> ItemDescription a -> Bool)
-> (ItemDescription a -> ItemDescription a -> ItemDescription a)
-> (ItemDescription a -> ItemDescription a -> ItemDescription a)
-> Ord (ItemDescription a)
ItemDescription a -> ItemDescription a -> Bool
ItemDescription a -> ItemDescription a -> Ordering
ItemDescription a -> ItemDescription a -> ItemDescription a
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (ItemDescription a)
forall a. Ord a => ItemDescription a -> ItemDescription a -> Bool
forall a.
Ord a =>
ItemDescription a -> ItemDescription a -> Ordering
forall a.
Ord a =>
ItemDescription a -> ItemDescription a -> ItemDescription a
$ccompare :: forall a.
Ord a =>
ItemDescription a -> ItemDescription a -> Ordering
compare :: ItemDescription a -> ItemDescription a -> Ordering
$c< :: forall a. Ord a => ItemDescription a -> ItemDescription a -> Bool
< :: ItemDescription a -> ItemDescription a -> Bool
$c<= :: forall a. Ord a => ItemDescription a -> ItemDescription a -> Bool
<= :: ItemDescription a -> ItemDescription a -> Bool
$c> :: forall a. Ord a => ItemDescription a -> ItemDescription a -> Bool
> :: ItemDescription a -> ItemDescription a -> Bool
$c>= :: forall a. Ord a => ItemDescription a -> ItemDescription a -> Bool
>= :: ItemDescription a -> ItemDescription a -> Bool
$cmax :: forall a.
Ord a =>
ItemDescription a -> ItemDescription a -> ItemDescription a
max :: ItemDescription a -> ItemDescription a -> ItemDescription a
$cmin :: forall a.
Ord a =>
ItemDescription a -> ItemDescription a -> ItemDescription a
min :: ItemDescription a -> ItemDescription a -> ItemDescription a
Ord, Int -> ItemDescription a -> [Char] -> [Char]
[ItemDescription a] -> [Char] -> [Char]
ItemDescription a -> [Char]
(Int -> ItemDescription a -> [Char] -> [Char])
-> (ItemDescription a -> [Char])
-> ([ItemDescription a] -> [Char] -> [Char])
-> Show (ItemDescription a)
forall a. Show a => Int -> ItemDescription a -> [Char] -> [Char]
forall a. Show a => [ItemDescription a] -> [Char] -> [Char]
forall a. Show a => ItemDescription a -> [Char]
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ItemDescription a -> [Char] -> [Char]
showsPrec :: Int -> ItemDescription a -> [Char] -> [Char]
$cshow :: forall a. Show a => ItemDescription a -> [Char]
show :: ItemDescription a -> [Char]
$cshowList :: forall a. Show a => [ItemDescription a] -> [Char] -> [Char]
showList :: [ItemDescription a] -> [Char] -> [Char]
Show)

instance (FromJSON a) => FromJSON (ItemDescription a) where
  parseJSON :: Value -> Parser (ItemDescription a)
parseJSON Value
x =
    [a] -> ItemDescription a
forall a. [a] -> ItemDescription a
ItemList ([a] -> ItemDescription a)
-> Parser [a] -> Parser (ItemDescription a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
      Parser (ItemDescription a)
-> Parser (ItemDescription a) -> Parser (ItemDescription a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> ItemDescription a
forall a. a -> ItemDescription a
ItemType (a -> ItemDescription a) -> Parser a -> Parser (ItemDescription a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

getSchemaReferences :: SchemaType -> [SchemaIdReference]
getSchemaReferences :: SchemaType -> [SchemaIdReference]
getSchemaReferences = \case
  Simple SingleOrList Text
_ -> []
  Alternatives [SchemaType]
xs -> (SchemaType -> [SchemaIdReference])
-> [SchemaType] -> [SchemaIdReference]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SchemaType -> [SchemaIdReference]
getSchemaReferences [SchemaType]
xs
  Reference SchemaIdReference
x -> SchemaIdReference -> [SchemaIdReference]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure SchemaIdReference
x
  ListOf SchemaType
x -> SchemaType -> [SchemaIdReference]
getSchemaReferences SchemaType
x
  EnumList NonEmpty Text
_ -> []

-- | A subset of all JSON schemas, conforming to internal Swarm conventions.
--
-- Conveniently, this extra representation layer
-- is able to enforce (via 'toSwarmSchema') that all "object"
-- definitions in the schema contain the @"additionalProperties": true@ attribute.
data SwarmSchema = SwarmSchema
  { SwarmSchema -> SchemaType
schemaType :: SchemaType
  , SwarmSchema -> Maybe Value
defaultValue :: Maybe Value
  , SwarmSchema -> Maybe Pandoc
objectDescription :: Maybe Pandoc
  , SwarmSchema -> Maybe (Map Text SwarmSchema)
properties :: Maybe (Map Text SwarmSchema)
  , SwarmSchema -> Maybe (ItemDescription SwarmSchema)
itemsDescription :: Maybe (ItemDescription SwarmSchema)
  , SwarmSchema -> [Value]
examples :: [Value]
  }
  deriving (SwarmSchema -> SwarmSchema -> Bool
(SwarmSchema -> SwarmSchema -> Bool)
-> (SwarmSchema -> SwarmSchema -> Bool) -> Eq SwarmSchema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SwarmSchema -> SwarmSchema -> Bool
== :: SwarmSchema -> SwarmSchema -> Bool
$c/= :: SwarmSchema -> SwarmSchema -> Bool
/= :: SwarmSchema -> SwarmSchema -> Bool
Eq, Eq SwarmSchema
Eq SwarmSchema =>
(SwarmSchema -> SwarmSchema -> Ordering)
-> (SwarmSchema -> SwarmSchema -> Bool)
-> (SwarmSchema -> SwarmSchema -> Bool)
-> (SwarmSchema -> SwarmSchema -> Bool)
-> (SwarmSchema -> SwarmSchema -> Bool)
-> (SwarmSchema -> SwarmSchema -> SwarmSchema)
-> (SwarmSchema -> SwarmSchema -> SwarmSchema)
-> Ord SwarmSchema
SwarmSchema -> SwarmSchema -> Bool
SwarmSchema -> SwarmSchema -> Ordering
SwarmSchema -> SwarmSchema -> SwarmSchema
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SwarmSchema -> SwarmSchema -> Ordering
compare :: SwarmSchema -> SwarmSchema -> Ordering
$c< :: SwarmSchema -> SwarmSchema -> Bool
< :: SwarmSchema -> SwarmSchema -> Bool
$c<= :: SwarmSchema -> SwarmSchema -> Bool
<= :: SwarmSchema -> SwarmSchema -> Bool
$c> :: SwarmSchema -> SwarmSchema -> Bool
> :: SwarmSchema -> SwarmSchema -> Bool
$c>= :: SwarmSchema -> SwarmSchema -> Bool
>= :: SwarmSchema -> SwarmSchema -> Bool
$cmax :: SwarmSchema -> SwarmSchema -> SwarmSchema
max :: SwarmSchema -> SwarmSchema -> SwarmSchema
$cmin :: SwarmSchema -> SwarmSchema -> SwarmSchema
min :: SwarmSchema -> SwarmSchema -> SwarmSchema
Ord, Int -> SwarmSchema -> [Char] -> [Char]
[SwarmSchema] -> [Char] -> [Char]
SwarmSchema -> [Char]
(Int -> SwarmSchema -> [Char] -> [Char])
-> (SwarmSchema -> [Char])
-> ([SwarmSchema] -> [Char] -> [Char])
-> Show SwarmSchema
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> SwarmSchema -> [Char] -> [Char]
showsPrec :: Int -> SwarmSchema -> [Char] -> [Char]
$cshow :: SwarmSchema -> [Char]
show :: SwarmSchema -> [Char]
$cshowList :: [SwarmSchema] -> [Char] -> [Char]
showList :: [SwarmSchema] -> [Char] -> [Char]
Show)

instance FromJSON SwarmSchema where
  parseJSON :: Value -> Parser SwarmSchema
parseJSON Value
x = do
    SchemaRaw
rawSchema :: rawSchema <- Value -> Parser SchemaRaw
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x
    SchemaRaw -> Parser SwarmSchema
forall (m :: * -> *). MonadFail m => SchemaRaw -> m SwarmSchema
toSwarmSchema SchemaRaw
rawSchema

getMarkdown :: MonadFail m => Text -> m Pandoc
getMarkdown :: forall (m :: * -> *). MonadFail m => Text -> m Pandoc
getMarkdown Text
desc = case PandocPure Pandoc -> Either PandocError Pandoc
forall a. PandocPure a -> Either PandocError a
runPure (ReaderOptions -> Text -> PandocPure Pandoc
forall (m :: * -> *) a.
(PandocMonad m, ToSources a) =>
ReaderOptions -> a -> m Pandoc
readMarkdown ReaderOptions
forall a. Default a => a
def Text
desc) of
  Right Pandoc
d -> Pandoc -> m Pandoc
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Pandoc
d
  Left PandocError
err -> [Char] -> m Pandoc
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> m Pandoc) -> [Char] -> m Pandoc
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack (Text -> [Char]) -> Text -> [Char]
forall a b. (a -> b) -> a -> b
$ PandocError -> Text
renderError PandocError
err

toSwarmSchema :: MonadFail m => SchemaRaw -> m SwarmSchema
toSwarmSchema :: forall (m :: * -> *). MonadFail m => SchemaRaw -> m SwarmSchema
toSwarmSchema SchemaRaw
rawSchema = do
  SchemaType
theType <- m SchemaType
-> (SchemaType -> m SchemaType) -> Maybe SchemaType -> m SchemaType
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([Char] -> m SchemaType
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Unspecified sub-schema type") SchemaType -> m SchemaType
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe SchemaType
maybeType
  Maybe Pandoc
markdownDescription <- (Text -> m Pandoc) -> Maybe Text -> m (Maybe Pandoc)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM Text -> m Pandoc
forall (m :: * -> *). MonadFail m => Text -> m Pandoc
getMarkdown (Maybe Text -> m (Maybe Pandoc)) -> Maybe Text -> m (Maybe Pandoc)
forall a b. (a -> b) -> a -> b
$ SchemaRaw -> Maybe Text
_description SchemaRaw
rawSchema

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe (Map Text SwarmSchema) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (SchemaRaw -> Maybe (Map Text SwarmSchema)
_properties SchemaRaw
rawSchema) Bool -> Bool -> Bool
|| Bool -> Bool
not (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True (SchemaRaw -> Maybe Bool
_additionalProperties SchemaRaw
rawSchema))) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    [Char] -> m ()
forall a. [Char] -> m a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"All objects must specify '\"additionalProperties\": true'"

  SwarmSchema -> m SwarmSchema
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
    SwarmSchema
      { schemaType :: SchemaType
schemaType = SchemaType
theType
      , defaultValue :: Maybe Value
defaultValue = SchemaRaw -> Maybe Value
_default SchemaRaw
rawSchema
      , objectDescription :: Maybe Pandoc
objectDescription = Maybe Pandoc
markdownDescription Maybe Pandoc -> Maybe Pandoc -> Maybe Pandoc
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Blocks -> Pandoc
doc (Blocks -> Pandoc) -> (Text -> Blocks) -> Text -> Pandoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> Blocks
plain (Inlines -> Blocks) -> (Text -> Inlines) -> Text -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text (Text -> Pandoc) -> Maybe Text -> Maybe Pandoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SchemaRaw -> Maybe Text
_name SchemaRaw
rawSchema
      , examples :: [Value]
examples = [Value] -> Maybe [Value] -> [Value]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Value] -> [Value]) -> Maybe [Value] -> [Value]
forall a b. (a -> b) -> a -> b
$ SchemaRaw -> Maybe [Value]
_examples SchemaRaw
rawSchema
      , properties :: Maybe (Map Text SwarmSchema)
properties = SchemaRaw -> Maybe (Map Text SwarmSchema)
_properties SchemaRaw
rawSchema
      , itemsDescription :: Maybe (ItemDescription SwarmSchema)
itemsDescription = SchemaRaw -> Maybe (ItemDescription SwarmSchema)
_items SchemaRaw
rawSchema
      }
 where
  maybeType :: Maybe SchemaType
maybeType = SchemaRaw -> Maybe SchemaType
extractSchemaType SchemaRaw
rawSchema

-- * Utilities

-- | Recursively extract references to other schemas
extractReferences :: SwarmSchema -> Set SchemaIdReference
extractReferences :: SwarmSchema -> Set SchemaIdReference
extractReferences SwarmSchema
s = Set SchemaIdReference
thisRefList Set SchemaIdReference
-> Set SchemaIdReference -> Set SchemaIdReference
forall a. Semigroup a => a -> a -> a
<> Set SchemaIdReference
otherRefLists
 where
  thisRefList :: Set SchemaIdReference
thisRefList = [SchemaIdReference] -> Set SchemaIdReference
forall a. Ord a => [a] -> Set a
Set.fromList ([SchemaIdReference] -> Set SchemaIdReference)
-> (SchemaType -> [SchemaIdReference])
-> SchemaType
-> Set SchemaIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaType -> [SchemaIdReference]
getSchemaReferences (SchemaType -> Set SchemaIdReference)
-> SchemaType -> Set SchemaIdReference
forall a b. (a -> b) -> a -> b
$ SwarmSchema -> SchemaType
schemaType SwarmSchema
s

  otherSchemas :: [SwarmSchema]
otherSchemas = [SwarmSchema]
-> (Map Text SwarmSchema -> [SwarmSchema])
-> Maybe (Map Text SwarmSchema)
-> [SwarmSchema]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Map Text SwarmSchema -> [SwarmSchema]
forall k a. Map k a -> [a]
M.elems (Maybe (Map Text SwarmSchema) -> [SwarmSchema])
-> Maybe (Map Text SwarmSchema) -> [SwarmSchema]
forall a b. (a -> b) -> a -> b
$ SwarmSchema -> Maybe (Map Text SwarmSchema)
properties SwarmSchema
s
  otherRefLists :: Set SchemaIdReference
otherRefLists = [Set SchemaIdReference] -> Set SchemaIdReference
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set SchemaIdReference] -> Set SchemaIdReference)
-> [Set SchemaIdReference] -> Set SchemaIdReference
forall a b. (a -> b) -> a -> b
$ (SwarmSchema -> Set SchemaIdReference)
-> [SwarmSchema] -> [Set SchemaIdReference]
forall a b. (a -> b) -> [a] -> [b]
map SwarmSchema -> Set SchemaIdReference
extractReferences [SwarmSchema]
otherSchemas