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

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

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