-- |
-- 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 bespoke parser for a small subset of JSON Schema is implemented here,
-- simply for rendering Markdown documentation from Swarm's schema.
module Swarm.Doc.Schema.Parse where

import Control.Applicative ((<|>))
import Data.Aeson
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Swarm.Doc.Schema.Refined
import Text.Pandoc

-- | Includes everything needed to
-- render the schema to markdown
data SchemaData = SchemaData
  { SchemaData -> FilePath
schemaPath :: FilePath
  , SchemaData -> ToplevelSchema
schemaContent :: ToplevelSchema
  , SchemaData -> [Pandoc]
markdownFooters :: [Pandoc]
  }

data Members
  = ObjectProperties (Map Text SwarmSchema)
  | ListMembers (ItemDescription SwarmSchema)
  deriving (Members -> Members -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Members -> Members -> Bool
$c/= :: Members -> Members -> Bool
== :: Members -> Members -> Bool
$c== :: Members -> Members -> Bool
Eq, Eq Members
Members -> Members -> Bool
Members -> Members -> Ordering
Members -> Members -> Members
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
min :: Members -> Members -> Members
$cmin :: Members -> Members -> Members
max :: Members -> Members -> Members
$cmax :: Members -> Members -> Members
>= :: Members -> Members -> Bool
$c>= :: Members -> Members -> Bool
> :: Members -> Members -> Bool
$c> :: Members -> Members -> Bool
<= :: Members -> Members -> Bool
$c<= :: Members -> Members -> Bool
< :: Members -> Members -> Bool
$c< :: Members -> Members -> Bool
compare :: Members -> Members -> Ordering
$ccompare :: Members -> Members -> Ordering
Ord, Int -> Members -> ShowS
[Members] -> ShowS
Members -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Members] -> ShowS
$cshowList :: [Members] -> ShowS
show :: Members -> FilePath
$cshow :: Members -> FilePath
showsPrec :: Int -> Members -> ShowS
$cshowsPrec :: Int -> Members -> ShowS
Show)

data ToplevelSchema = ToplevelSchema
  { ToplevelSchema -> Text
title :: Text
  , ToplevelSchema -> Maybe Pandoc
description :: Maybe Pandoc
  , ToplevelSchema -> SwarmSchema
content :: SwarmSchema
  , ToplevelSchema -> Maybe Members
members :: Maybe Members
  , ToplevelSchema -> [FilePath]
footerPaths :: [FilePath]
  }
  deriving (ToplevelSchema -> ToplevelSchema -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ToplevelSchema -> ToplevelSchema -> Bool
$c/= :: ToplevelSchema -> ToplevelSchema -> Bool
== :: ToplevelSchema -> ToplevelSchema -> Bool
$c== :: ToplevelSchema -> ToplevelSchema -> Bool
Eq, Eq ToplevelSchema
ToplevelSchema -> ToplevelSchema -> Bool
ToplevelSchema -> ToplevelSchema -> Ordering
ToplevelSchema -> ToplevelSchema -> ToplevelSchema
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
min :: ToplevelSchema -> ToplevelSchema -> ToplevelSchema
$cmin :: ToplevelSchema -> ToplevelSchema -> ToplevelSchema
max :: ToplevelSchema -> ToplevelSchema -> ToplevelSchema
$cmax :: ToplevelSchema -> ToplevelSchema -> ToplevelSchema
>= :: ToplevelSchema -> ToplevelSchema -> Bool
$c>= :: ToplevelSchema -> ToplevelSchema -> Bool
> :: ToplevelSchema -> ToplevelSchema -> Bool
$c> :: ToplevelSchema -> ToplevelSchema -> Bool
<= :: ToplevelSchema -> ToplevelSchema -> Bool
$c<= :: ToplevelSchema -> ToplevelSchema -> Bool
< :: ToplevelSchema -> ToplevelSchema -> Bool
$c< :: ToplevelSchema -> ToplevelSchema -> Bool
compare :: ToplevelSchema -> ToplevelSchema -> Ordering
$ccompare :: ToplevelSchema -> ToplevelSchema -> Ordering
Ord, Int -> ToplevelSchema -> ShowS
[ToplevelSchema] -> ShowS
ToplevelSchema -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ToplevelSchema] -> ShowS
$cshowList :: [ToplevelSchema] -> ShowS
show :: ToplevelSchema -> FilePath
$cshow :: ToplevelSchema -> FilePath
showsPrec :: Int -> ToplevelSchema -> ShowS
$cshowsPrec :: Int -> ToplevelSchema -> ShowS
Show)

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

    Text
theTitle <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"Schema requires a title") forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ SchemaRaw -> Maybe Text
_title SchemaRaw
rawSchema
    let theFooters :: [FilePath]
theFooters = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ SchemaRaw -> Maybe [FilePath]
_footers SchemaRaw
rawSchema
        maybeMembers :: Maybe Members
maybeMembers =
          Map Text SwarmSchema -> Members
ObjectProperties forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SwarmSchema -> Maybe (Map Text SwarmSchema)
properties SwarmSchema
swarmSchema
            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ItemDescription SwarmSchema -> Members
ListMembers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SwarmSchema -> Maybe (ItemDescription SwarmSchema)
itemsDescription SwarmSchema
swarmSchema
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text
-> Maybe Pandoc
-> SwarmSchema
-> Maybe Members
-> [FilePath]
-> ToplevelSchema
ToplevelSchema Text
theTitle (SwarmSchema -> Maybe Pandoc
objectDescription SwarmSchema
swarmSchema) SwarmSchema
swarmSchema Maybe Members
maybeMembers [FilePath]
theFooters