{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveLift #-}

module Argo.Internal.Schema.Schema where

import qualified Argo.Internal.Json.Member as Member
import qualified Argo.Internal.Json.Name as Name
import qualified Argo.Internal.Json.String as String
import qualified Argo.Internal.Json.Value as Value
import qualified Argo.Internal.Schema.Identifier as Identifier
import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified Argo.Vendor.Text as Text
import qualified Data.List.NonEmpty as NonEmpty
import qualified GHC.Generics as Generics
import qualified Numeric.Natural as Natural

-- | A JSON Schema.
-- <https://datatracker.ietf.org/doc/html/draft-handrews-json-schema-01>
data Schema
    = Array
        (Maybe Natural.Natural)
        (Maybe Natural.Natural)
        (Either Schema (NonEmpty.NonEmpty Schema))
        (Maybe Schema)
    | Boolean
    | Const Value.Value
    | False
    | Integer (Maybe Integer) (Maybe Integer)
    | Null
    | Number
    | Object [(Name.Name, Schema)] [Name.Name] (Maybe Schema)
    | OneOf [Schema]
    | Ref Identifier.Identifier
    | String (Maybe Natural.Natural) (Maybe Natural.Natural)
    | True
    deriving (Schema -> Schema -> Bool
(Schema -> Schema -> Bool)
-> (Schema -> Schema -> Bool) -> Eq Schema
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Schema -> Schema -> Bool
$c/= :: Schema -> Schema -> Bool
== :: Schema -> Schema -> Bool
$c== :: Schema -> Schema -> Bool
Eq, (forall x. Schema -> Rep Schema x)
-> (forall x. Rep Schema x -> Schema) -> Generic Schema
forall x. Rep Schema x -> Schema
forall x. Schema -> Rep Schema x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Schema x -> Schema
$cfrom :: forall x. Schema -> Rep Schema x
Generics.Generic, Schema -> Q Exp
Schema -> Q (TExp Schema)
(Schema -> Q Exp) -> (Schema -> Q (TExp Schema)) -> Lift Schema
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Schema -> Q (TExp Schema)
$cliftTyped :: Schema -> Q (TExp Schema)
lift :: Schema -> Q Exp
$clift :: Schema -> Q Exp
TH.Lift, Schema -> ()
(Schema -> ()) -> NFData Schema
forall a. (a -> ()) -> NFData a
rnf :: Schema -> ()
$crnf :: Schema -> ()
DeepSeq.NFData, Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
(Int -> Schema -> ShowS)
-> (Schema -> String) -> ([Schema] -> ShowS) -> Show Schema
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Schema] -> ShowS
$cshowList :: [Schema] -> ShowS
show :: Schema -> String
$cshow :: Schema -> String
showsPrec :: Int -> Schema -> ShowS
$cshowsPrec :: Int -> Schema -> ShowS
Show)

instance Semigroup Schema where
    Schema
x <> :: Schema -> Schema -> Schema
<> Schema
y = case (Schema
x, Schema
y) of
        (OneOf [Schema]
xs, OneOf [Schema]
ys) -> [Schema] -> Schema
OneOf ([Schema] -> Schema) -> [Schema] -> Schema
forall a b. (a -> b) -> a -> b
$ [Schema]
xs [Schema] -> [Schema] -> [Schema]
forall a. Semigroup a => a -> a -> a
<> [Schema]
ys
        (OneOf [Schema]
xs, Schema
_) -> [Schema] -> Schema
OneOf ([Schema] -> Schema) -> [Schema] -> Schema
forall a b. (a -> b) -> a -> b
$ Schema
y Schema -> [Schema] -> [Schema]
forall a. a -> [a] -> [a]
: [Schema]
xs
        (Schema
_, OneOf [Schema]
ys) -> [Schema] -> Schema
OneOf ([Schema] -> Schema) -> [Schema] -> Schema
forall a b. (a -> b) -> a -> b
$ Schema
x Schema -> [Schema] -> [Schema]
forall a. a -> [a] -> [a]
: [Schema]
ys
        (Schema
_, Schema
_) -> [Schema] -> Schema
OneOf [Schema
x, Schema
y]

instance Monoid Schema where
    mempty :: Schema
mempty = Schema
Argo.Internal.Schema.Schema.True

member :: String -> a -> Member.Member a
member :: String -> a -> Member a
member String
k a
v =
    (Name, a) -> Member a
forall value. (Name, value) -> Member value
Member.fromTuple (String -> Name
Name.fromString (String -> Name) -> (Text -> String) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
k, a
v)

maybeRef :: (Maybe Identifier.Identifier, Schema) -> Schema
maybeRef :: (Maybe Identifier, Schema) -> Schema
maybeRef (Maybe Identifier
m, Schema
s) = Schema -> (Identifier -> Schema) -> Maybe Identifier -> Schema
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Schema
s Identifier -> Schema
Ref Maybe Identifier
m

false :: Schema
false :: Schema
false = Schema
Argo.Internal.Schema.Schema.False

true :: Schema
true :: Schema
true = Schema
Argo.Internal.Schema.Schema.True

unidentified :: Schema -> (Maybe Identifier.Identifier, Schema)
unidentified :: Schema -> (Maybe Identifier, Schema)
unidentified Schema
s = (Maybe Identifier
forall a. Maybe a
Nothing, Schema
s)

withIdentifier
    :: Identifier.Identifier -> Schema -> (Maybe Identifier.Identifier, Schema)
withIdentifier :: Identifier -> Schema -> (Maybe Identifier, Schema)
withIdentifier Identifier
i Schema
s = (Identifier -> Maybe Identifier
forall a. a -> Maybe a
Just Identifier
i, Schema
s)