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

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Render a markdown document fragment
-- from the Scenario JSON schema files.
module Swarm.Doc.Schema.Render where

import Control.Arrow (left, (&&&))
import Control.Monad.Except (runExceptT)
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)
import Data.Scientific (FPFormat (..), Scientific, formatScientific)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import Data.Vector qualified as V
import Swarm.Doc.Schema.Arrangement
import Swarm.Doc.Schema.Parse
import Swarm.Doc.Schema.Refined
import Swarm.Doc.Schema.SchemaType
import Swarm.Doc.Wiki.Util
import Swarm.Util (applyWhen, brackets, quote, showT)
import System.Directory (listDirectory)
import System.FilePath (splitExtension, (<.>), (</>))
import Text.Pandoc
import Text.Pandoc.Builder
import Text.Pandoc.Walk (query)

scenariosDir :: FilePath
scenariosDir :: FilePath
scenariosDir = FilePath
"data/scenarios"

docFragmentsDir :: FilePath
docFragmentsDir :: FilePath
docFragmentsDir = FilePath
scenariosDir FilePath -> FilePath -> FilePath
</> FilePath
"_doc-fragments"

schemasDir :: FilePath
schemasDir :: FilePath
schemasDir = FilePath
"data/schema"

schemaExtension :: String
schemaExtension :: FilePath
schemaExtension = FilePath
".json"

propertyColumnHeadings :: [T.Text]
propertyColumnHeadings :: [Text]
propertyColumnHeadings =
  [ Text
"Key"
  , Text
"Default?"
  , Text
"Type"
  , Text
"Description"
  ]

listColumnHeadings :: [T.Text]
listColumnHeadings :: [Text]
listColumnHeadings =
  [ Text
"Index"
  , Text
"Type"
  , Text
"Description"
  ]

makeTitleMap :: [SchemaData] -> Map SchemaIdReference T.Text
makeTitleMap :: [SchemaData] -> Map SchemaIdReference Text
makeTitleMap = [(SchemaIdReference, Text)] -> Map SchemaIdReference Text
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(SchemaIdReference, Text)] -> Map SchemaIdReference Text)
-> ([SchemaData] -> [(SchemaIdReference, Text)])
-> [SchemaData]
-> Map SchemaIdReference Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SchemaData -> (SchemaIdReference, Text))
-> [SchemaData] -> [(SchemaIdReference, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SchemaIdReference
fromFilePath (FilePath -> SchemaIdReference)
-> (SchemaData -> FilePath) -> SchemaData -> SchemaIdReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaData -> FilePath
schemaPath (SchemaData -> SchemaIdReference)
-> (SchemaData -> Text) -> SchemaData -> (SchemaIdReference, Text)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ToplevelSchema -> Text
title (ToplevelSchema -> Text)
-> (SchemaData -> ToplevelSchema) -> SchemaData -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaData -> ToplevelSchema
schemaContent)

makePandocTable :: Map SchemaIdReference T.Text -> SchemaData -> Pandoc
makePandocTable :: Map SchemaIdReference Text -> SchemaData -> Pandoc
makePandocTable Map SchemaIdReference Text
titleMap (SchemaData FilePath
_ (ToplevelSchema Text
theTitle Maybe Pandoc
theDescription SwarmSchema
_schema Maybe Members
theMembers [FilePath]
_) [Pandoc]
parsedFooters) =
  Inlines -> Pandoc -> Pandoc
setTitle (Text -> Inlines
text Text
"JSON Schema for Scenarios") (Pandoc -> Pandoc) -> Pandoc -> Pandoc
forall a b. (a -> b) -> a -> b
$
    Blocks -> Pandoc
doc (Int -> Inlines -> Blocks
header Int
3 (Text -> Inlines
text Text
theTitle))
      Pandoc -> Pandoc -> Pandoc
forall a. Semigroup a => a -> a -> a
<> Pandoc -> Maybe Pandoc -> Pandoc
forall a. a -> Maybe a -> a
fromMaybe Pandoc
forall a. Monoid a => a
mempty Maybe Pandoc
theDescription
      Pandoc -> Pandoc -> Pandoc
forall a. Semigroup a => a -> a -> a
<> Pandoc -> (Members -> Pandoc) -> Maybe Members -> Pandoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Pandoc
forall a. Monoid a => a
mempty Members -> Pandoc
mkTable Maybe Members
theMembers
      Pandoc -> Pandoc -> Pandoc
forall a. Semigroup a => a -> a -> a
<> [Pandoc] -> Pandoc
forall a. Monoid a => [a] -> a
mconcat [Pandoc]
parsedFooters
 where
  renderItems :: ItemDescription SwarmSchema -> Blocks
renderItems ItemDescription SwarmSchema
someStuff = case ItemDescription SwarmSchema
someStuff of
    ItemType SwarmSchema
x -> Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"List of " Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Map SchemaIdReference Text -> SchemaType -> Inlines
listToText Map SchemaIdReference Text
titleMap (SwarmSchema -> SchemaType
schemaType SwarmSchema
x)
    ItemList [SwarmSchema]
xs ->
      Bool
-> [Text]
-> Map SchemaIdReference Text
-> Map Text SwarmSchema
-> Blocks
makePropsTable Bool
False [Text]
listColumnHeadings Map SchemaIdReference Text
titleMap
        (Map Text SwarmSchema -> Blocks)
-> ([(Text, SwarmSchema)] -> Map Text SwarmSchema)
-> [(Text, SwarmSchema)]
-> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, SwarmSchema)] -> Map Text SwarmSchema
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
        ([(Text, SwarmSchema)] -> Blocks)
-> [(Text, SwarmSchema)] -> Blocks
forall a b. (a -> b) -> a -> b
$ [Text] -> [SwarmSchema] -> [(Text, SwarmSchema)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Text) -> [Int] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Text
forall a. Show a => a -> Text
showT [Int
0 :: Int ..]) [SwarmSchema]
xs

  mkTable :: Members -> Pandoc
mkTable Members
x = Blocks -> Pandoc
doc (Blocks -> Pandoc) -> Blocks -> Pandoc
forall a b. (a -> b) -> a -> b
$ case Members
x of
    ObjectProperties Map Text SwarmSchema
props -> Bool
-> [Text]
-> Map SchemaIdReference Text
-> Map Text SwarmSchema
-> Blocks
makePropsTable Bool
True [Text]
propertyColumnHeadings Map SchemaIdReference Text
titleMap Map Text SwarmSchema
props
    ListMembers ItemDescription SwarmSchema
someStuff -> ItemDescription SwarmSchema -> Blocks
renderItems ItemDescription SwarmSchema
someStuff
    EnumMembers NonEmpty Text
enumMembers ->
      [Blocks] -> [[Blocks]] -> Blocks
simpleTable [Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text Text
"Member"] ([[Blocks]] -> Blocks) -> [[Blocks]] -> Blocks
forall a b. (a -> b) -> a -> b
$
        (Text -> [Blocks]) -> [Text] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
m -> [Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code Text
m]) ([Text] -> [[Blocks]]) -> [Text] -> [[Blocks]]
forall a b. (a -> b) -> a -> b
$
          NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NE.toList NonEmpty Text
enumMembers

genPropsRow :: Bool -> Map SchemaIdReference T.Text -> (T.Text, SwarmSchema) -> [Blocks]
genPropsRow :: Bool
-> Map SchemaIdReference Text -> (Text, SwarmSchema) -> [Blocks]
genPropsRow Bool
includeDefaultColumn Map SchemaIdReference Text
titleMap (Text
k, SwarmSchema
x) =
  Blocks
firstColumn Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
: Bool -> ([Blocks] -> [Blocks]) -> [Blocks] -> [Blocks]
forall a. Bool -> (a -> a) -> a -> a
applyWhen Bool
includeDefaultColumn (Blocks
defaultColumn Blocks -> [Blocks] -> [Blocks]
forall a. a -> [a] -> [a]
:) [Blocks]
tailColumns
 where
  firstColumn :: Blocks
firstColumn = Inlines -> Blocks
plain (Inlines -> Blocks) -> Inlines -> Blocks
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
code Text
k
  defaultColumn :: Blocks
defaultColumn = Blocks -> (Value -> Blocks) -> Maybe Value -> Blocks
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Blocks
forall a. Monoid a => a
mempty (Inlines -> Blocks
plain (Inlines -> Blocks) -> (Value -> Inlines) -> Value -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
code (Text -> Inlines) -> (Value -> Text) -> Value -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
renderValue) (Maybe Value -> Blocks) -> Maybe Value -> Blocks
forall a b. (a -> b) -> a -> b
$ SwarmSchema -> Maybe Value
defaultValue SwarmSchema
x
  tailColumns :: [Blocks]
tailColumns =
    [ Inlines -> Blocks
plain (Inlines -> Blocks)
-> (SchemaType -> Inlines) -> SchemaType -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map SchemaIdReference Text -> SchemaType -> Inlines
listToText Map SchemaIdReference Text
titleMap (SchemaType -> Blocks) -> SchemaType -> Blocks
forall a b. (a -> b) -> a -> b
$ SwarmSchema -> SchemaType
schemaType SwarmSchema
x
    , [Block] -> Blocks
forall a. [a] -> Many a
fromList ([Block] -> Blocks) -> [Block] -> Blocks
forall a b. (a -> b) -> a -> b
$ [Block] -> (Pandoc -> [Block]) -> Maybe Pandoc -> [Block]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (([Block] -> [Block]) -> Pandoc -> [Block]
forall c. Monoid c => ([Block] -> c) -> Pandoc -> c
forall a b c. (Walkable a b, Monoid c) => (a -> c) -> b -> c
query [Block] -> [Block]
forall a. a -> a
id) (Maybe Pandoc -> [Block]) -> Maybe Pandoc -> [Block]
forall a b. (a -> b) -> a -> b
$ SwarmSchema -> Maybe Pandoc
objectDescription SwarmSchema
x
    ]

makePropsTable ::
  Bool ->
  [T.Text] ->
  Map SchemaIdReference T.Text ->
  Map T.Text SwarmSchema ->
  Blocks
makePropsTable :: Bool
-> [Text]
-> Map SchemaIdReference Text
-> Map Text SwarmSchema
-> Blocks
makePropsTable Bool
includeDefaultColumn [Text]
headingsList Map SchemaIdReference Text
titleMap =
  [Blocks] -> [[Blocks]] -> Blocks
simpleTable [Blocks]
headerRow ([[Blocks]] -> Blocks)
-> (Map Text SwarmSchema -> [[Blocks]])
-> Map Text SwarmSchema
-> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, SwarmSchema) -> [Blocks])
-> [(Text, SwarmSchema)] -> [[Blocks]]
forall a b. (a -> b) -> [a] -> [b]
map (Bool
-> Map SchemaIdReference Text -> (Text, SwarmSchema) -> [Blocks]
genPropsRow Bool
includeDefaultColumn Map SchemaIdReference Text
titleMap) ([(Text, SwarmSchema)] -> [[Blocks]])
-> (Map Text SwarmSchema -> [(Text, SwarmSchema)])
-> Map Text SwarmSchema
-> [[Blocks]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text SwarmSchema -> [(Text, SwarmSchema)]
forall k a. Map k a -> [(k, a)]
M.toList
 where
  headerRow :: [Blocks]
headerRow = (Text -> Blocks) -> [Text] -> [Blocks]
forall a b. (a -> b) -> [a] -> [b]
map (Inlines -> Blocks
plain (Inlines -> Blocks) -> (Text -> Inlines) -> Text -> Blocks
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text) [Text]
headingsList

type FileStemAndExtension = (FilePath, String)

recombineExtension :: FileStemAndExtension -> FilePath
recombineExtension :: FileStemAndExtension -> FilePath
recombineExtension (FilePath
filenameStem, FilePath
fileExtension) =
  FilePath
filenameStem FilePath -> FilePath -> FilePath
<.> FilePath
fileExtension

genMarkdown :: [SchemaData] -> Either T.Text T.Text
genMarkdown :: [SchemaData] -> Either Text Text
genMarkdown [SchemaData]
schemaThings =
  Pandoc -> Either Text Text
pandocToText Pandoc
pd
 where
  titleMap :: Map SchemaIdReference Text
titleMap = [SchemaData] -> Map SchemaIdReference Text
makeTitleMap [SchemaData]
schemaThings
  pd :: Pandoc
pd =
    [Pandoc] -> Pandoc
forall a. Monoid a => [a] -> a
mconcat ([Pandoc] -> Pandoc) -> [Pandoc] -> Pandoc
forall a b. (a -> b) -> a -> b
$
      (SchemaData -> Pandoc) -> [SchemaData] -> [Pandoc]
forall a b. (a -> b) -> [a] -> [b]
map (Map SchemaIdReference Text -> SchemaData -> Pandoc
makePandocTable Map SchemaIdReference Text
titleMap) ([SchemaData] -> [Pandoc]) -> [SchemaData] -> [Pandoc]
forall a b. (a -> b) -> a -> b
$
        SchemaIdReference -> [SchemaData] -> [SchemaData]
sortAndPruneSchemas (FilePath -> SchemaIdReference
fromFilePath FilePath
"scenario") [SchemaData]
schemaThings

parseSchemaFile :: FileStemAndExtension -> IO (Either T.Text ToplevelSchema)
parseSchemaFile :: FileStemAndExtension -> IO (Either Text ToplevelSchema)
parseSchemaFile FileStemAndExtension
stemAndExtension =
  (FilePath -> Text)
-> Either FilePath ToplevelSchema -> Either Text ToplevelSchema
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (Text -> Text
prependPath (Text -> Text) -> (FilePath -> Text) -> FilePath -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
T.pack) (Either FilePath ToplevelSchema -> Either Text ToplevelSchema)
-> IO (Either FilePath ToplevelSchema)
-> IO (Either Text ToplevelSchema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Either FilePath ToplevelSchema)
forall a. FromJSON a => FilePath -> IO (Either FilePath a)
eitherDecodeFileStrict FilePath
fullPath
 where
  prependPath :: Text -> Text
prependPath = (([Text] -> Text
T.unwords [Text
"in", Text -> Text
quote (FilePath -> Text
T.pack FilePath
filename)] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
  filename :: FilePath
filename = FileStemAndExtension -> FilePath
recombineExtension FileStemAndExtension
stemAndExtension
  fullPath :: FilePath
fullPath = FilePath
schemasDir FilePath -> FilePath -> FilePath
</> FilePath
filename

loadFooterContent :: (FilePath, ToplevelSchema) -> IO SchemaData
loadFooterContent :: (FilePath, ToplevelSchema) -> IO SchemaData
loadFooterContent (FilePath
fp, ToplevelSchema
schem) = do
  [Text]
xs <- (FilePath -> IO Text) -> [FilePath] -> IO [Text]
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) -> [a] -> m [b]
mapM (FilePath -> IO Text
TIO.readFile (FilePath -> IO Text)
-> (FilePath -> FilePath) -> FilePath -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
scenariosDir FilePath -> FilePath -> FilePath
</>)) ([FilePath] -> IO [Text]) -> [FilePath] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ ToplevelSchema -> [FilePath]
footerPaths ToplevelSchema
schem
  [Pandoc]
parsedFooters <- (Text -> IO Pandoc) -> [Text] -> IO [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) -> [a] -> m [b]
mapM Text -> IO Pandoc
forall (m :: * -> *). MonadFail m => Text -> m Pandoc
getMarkdown [Text]
xs
  SchemaData -> IO SchemaData
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (SchemaData -> IO SchemaData) -> SchemaData -> IO SchemaData
forall a b. (a -> b) -> a -> b
$
    FilePath -> ToplevelSchema -> [Pandoc] -> SchemaData
SchemaData
      FilePath
fp
      ToplevelSchema
schem
      [Pandoc]
parsedFooters

genScenarioSchemaDocs :: IO ()
genScenarioSchemaDocs :: IO ()
genScenarioSchemaDocs = do
  [FilePath]
dirContents <- FilePath -> IO [FilePath]
listDirectory FilePath
schemasDir
  let inputFiles :: [FileStemAndExtension]
inputFiles = (FileStemAndExtension -> Bool)
-> [FileStemAndExtension] -> [FileStemAndExtension]
forall a. (a -> Bool) -> [a] -> [a]
filter ((FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
schemaExtension) (FilePath -> Bool)
-> (FileStemAndExtension -> FilePath)
-> FileStemAndExtension
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileStemAndExtension -> FilePath
forall a b. (a, b) -> b
snd) ([FileStemAndExtension] -> [FileStemAndExtension])
-> [FileStemAndExtension] -> [FileStemAndExtension]
forall a b. (a -> b) -> a -> b
$ (FilePath -> FileStemAndExtension)
-> [FilePath] -> [FileStemAndExtension]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FileStemAndExtension
splitExtension [FilePath]
dirContents
  [(FilePath, Either Text ToplevelSchema)]
xs <- (FileStemAndExtension -> IO (FilePath, Either Text ToplevelSchema))
-> [FileStemAndExtension]
-> IO [(FilePath, Either Text ToplevelSchema)]
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) -> [a] -> m [b]
mapM ((FilePath, IO (Either Text ToplevelSchema))
-> IO (FilePath, Either Text ToplevelSchema)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(FilePath, f a) -> f (FilePath, a)
sequenceA ((FilePath, IO (Either Text ToplevelSchema))
 -> IO (FilePath, Either Text ToplevelSchema))
-> (FileStemAndExtension
    -> (FilePath, IO (Either Text ToplevelSchema)))
-> FileStemAndExtension
-> IO (FilePath, Either Text ToplevelSchema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FileStemAndExtension -> FilePath
recombineExtension (FileStemAndExtension -> FilePath)
-> (FileStemAndExtension -> IO (Either Text ToplevelSchema))
-> FileStemAndExtension
-> (FilePath, IO (Either Text ToplevelSchema))
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& FileStemAndExtension -> IO (Either Text ToplevelSchema)
parseSchemaFile)) [FileStemAndExtension]
inputFiles

  Either Text ()
result <- ExceptT Text IO () -> IO (Either Text ())
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT Text IO () -> IO (Either Text ()))
-> ExceptT Text IO () -> IO (Either Text ())
forall a b. (a -> b) -> a -> b
$ do
    [(FilePath, ToplevelSchema)]
schemaTuples <- Either Text [(FilePath, ToplevelSchema)]
-> ExceptT Text IO [(FilePath, ToplevelSchema)]
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either Text [(FilePath, ToplevelSchema)]
 -> ExceptT Text IO [(FilePath, ToplevelSchema)])
-> Either Text [(FilePath, ToplevelSchema)]
-> ExceptT Text IO [(FilePath, ToplevelSchema)]
forall a b. (a -> b) -> a -> b
$ ((FilePath, Either Text ToplevelSchema)
 -> Either Text (FilePath, ToplevelSchema))
-> [(FilePath, Either Text ToplevelSchema)]
-> Either Text [(FilePath, ToplevelSchema)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (FilePath, Either Text ToplevelSchema)
-> Either Text (FilePath, ToplevelSchema)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
(FilePath, f a) -> f (FilePath, a)
sequenceA [(FilePath, Either Text ToplevelSchema)]
xs
    [SchemaData]
things <- IO [SchemaData] -> ExceptT Text IO [SchemaData]
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [SchemaData] -> ExceptT Text IO [SchemaData])
-> IO [SchemaData] -> ExceptT Text IO [SchemaData]
forall a b. (a -> b) -> a -> b
$ ((FilePath, ToplevelSchema) -> IO SchemaData)
-> [(FilePath, ToplevelSchema)] -> IO [SchemaData]
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) -> [a] -> m [b]
mapM (FilePath, ToplevelSchema) -> IO SchemaData
loadFooterContent [(FilePath, ToplevelSchema)]
schemaTuples
    Text
myMarkdown <- Either Text Text -> ExceptT Text IO Text
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either Text Text -> ExceptT Text IO Text)
-> Either Text Text -> ExceptT Text IO Text
forall a b. (a -> b) -> a -> b
$ [SchemaData] -> Either Text Text
genMarkdown [SchemaData]
things
    Text
docHeader <- IO Text -> ExceptT Text IO Text
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> ExceptT Text IO Text)
-> IO Text -> ExceptT Text IO Text
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
TIO.readFile FilePath
"data/scenarios/_doc-fragments/header.md"
    IO () -> ExceptT Text IO ()
forall a. IO a -> ExceptT Text IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT Text IO ())
-> (Text -> IO ()) -> Text -> ExceptT Text IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
writeFile (FilePath
docFragmentsDir FilePath -> FilePath -> FilePath
</> FilePath
"SCHEMA.md") (FilePath -> IO ()) -> (Text -> FilePath) -> Text -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> FilePath
T.unpack (Text -> ExceptT Text IO ()) -> Text -> ExceptT Text IO ()
forall a b. (a -> b) -> a -> b
$ Text
docHeader Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
myMarkdown

  case Either Text ()
result of
    Left Text
e -> FilePath -> IO ()
forall a. Show a => a -> IO ()
print (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [FilePath
"Failed:", Text -> FilePath
T.unpack Text
e]
    Right ()
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

renderValue :: Value -> T.Text
renderValue :: Value -> Text
renderValue = \case
  Object Object
obj -> Object -> Text
forall a. Show a => a -> Text
showT Object
obj
  Array Array
arr -> Text -> Text
brackets (Text -> Text) -> ([Value] -> Text) -> [Value] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
", " ([Text] -> Text) -> ([Value] -> [Text]) -> [Value] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Text
renderValue ([Value] -> Text) -> [Value] -> Text
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
arr
  String Text
t -> Text -> Text
quote Text
t
  Number Scientific
num -> FilePath -> Text
T.pack (FilePath -> Text) -> FilePath -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> FilePath
formatNumberCompact Scientific
num
  Bool Bool
b -> Bool -> Text
forall a. Show a => a -> Text
showT Bool
b
  Value
Null -> Text
"null"

fragmentHref :: Map SchemaIdReference T.Text -> SchemaIdReference -> T.Text
fragmentHref :: Map SchemaIdReference Text -> SchemaIdReference -> Text
fragmentHref Map SchemaIdReference Text
titleMap r :: SchemaIdReference
r@(SchemaIdReference Text
ref) =
  Char -> Text -> Text
T.cons Char
'#' (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
T.toLower (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
" " Text
"-" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
x
 where
  x :: Text
x = Text -> SchemaIdReference -> Map SchemaIdReference Text -> Text
forall k a. Ord k => a -> k -> Map k a -> a
M.findWithDefault Text
ref SchemaIdReference
r Map SchemaIdReference Text
titleMap

listToText :: Map SchemaIdReference T.Text -> SchemaType -> Inlines
listToText :: Map SchemaIdReference Text -> SchemaType -> Inlines
listToText Map SchemaIdReference Text
titleMap = \case
  Simple SingleOrList Text
xs -> [Inlines] -> Inlines
renderAlternatives ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ (Text -> Inlines) -> [Text] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Inlines
code ([Text] -> [Inlines]) -> [Text] -> [Inlines]
forall a b. (a -> b) -> a -> b
$ SingleOrList Text -> [Text]
forall a. SingleOrList a -> [a]
getList SingleOrList Text
xs
  Alternatives [SchemaType]
xs -> [Inlines] -> Inlines
renderAlternatives ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ (SchemaType -> Inlines) -> [SchemaType] -> [Inlines]
forall a b. (a -> b) -> [a] -> [b]
map (Map SchemaIdReference Text -> SchemaType -> Inlines
listToText Map SchemaIdReference Text
titleMap) [SchemaType]
xs
  Reference r :: SchemaIdReference
r@(SchemaIdReference Text
x) -> SchemaIdReference -> Text -> Inlines
schemaLink SchemaIdReference
r Text
x
  ListOf SchemaType
x -> Map SchemaIdReference Text -> SchemaType -> Inlines
listToText Map SchemaIdReference Text
titleMap SchemaType
x Inlines -> Inlines -> Inlines
forall a. Semigroup a => a -> a -> a
<> Text -> Inlines
text Text
" list"
  EnumList NonEmpty Text
xs -> [Inlines] -> Inlines
renderAlternatives ([Inlines] -> Inlines) -> [Inlines] -> Inlines
forall a b. (a -> b) -> a -> b
$ NonEmpty Inlines -> [Inlines]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Inlines -> [Inlines]) -> NonEmpty Inlines -> [Inlines]
forall a b. (a -> b) -> a -> b
$ Text -> Inlines
text (Text -> Inlines) -> NonEmpty Text -> NonEmpty Inlines
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty Text
xs
 where
  renderAlternatives :: [Inlines] -> Inlines
renderAlternatives = [Inlines] -> Inlines
forall a. Monoid a => [a] -> a
mconcat ([Inlines] -> Inlines)
-> ([Inlines] -> [Inlines]) -> [Inlines] -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inlines -> [Inlines] -> [Inlines]
forall a. a -> [a] -> [a]
intersperse (Text -> Inlines
text Text
" or ")
  schemaLink :: SchemaIdReference -> Text -> Inlines
schemaLink SchemaIdReference
r = Text -> Text -> Inlines -> Inlines
link (Map SchemaIdReference Text -> SchemaIdReference -> Text
fragmentHref Map SchemaIdReference Text
titleMap SchemaIdReference
r) Text
"Link to object properties" (Inlines -> Inlines) -> (Text -> Inlines) -> Text -> Inlines
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Inlines
text

-- |
-- Strips trailing zeros and decimal point from a floating-point number
-- when possible.
--
-- Obtained from here: https://stackoverflow.com/a/35980995/105137
formatNumberCompact :: Scientific -> String
formatNumberCompact :: Scientific -> FilePath
formatNumberCompact Scientific
v
  | Scientific
v Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
0 = FilePath
"0"
  | Scientific -> Scientific
forall a. Num a => a -> a
abs Scientific
v Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
1e-5 Bool -> Bool -> Bool
|| Scientific -> Scientific
forall a. Num a => a -> a
abs Scientific
v Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
> Scientific
1e10 = FPFormat -> Maybe Int -> Scientific -> FilePath
formatScientific FPFormat
Exponent Maybe Int
forall a. Maybe a
Nothing Scientific
v
  | Scientific
v Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
- Integer -> Scientific
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Scientific -> Integer
forall b. Integral b => Scientific -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
v :: Integer) Scientific -> Scientific -> Bool
forall a. Eq a => a -> a -> Bool
== Scientific
0 = FPFormat -> Maybe Int -> Scientific -> FilePath
formatScientific FPFormat
Fixed (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0) Scientific
v
  | Bool
otherwise = FPFormat -> Maybe Int -> Scientific -> FilePath
formatScientific FPFormat
Generic Maybe Int
forall a. Maybe a
Nothing Scientific
v