{-# 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 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
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 t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => Schema -> m Exp
forall (m :: * -> *). Quote m => Schema -> Code m Schema
liftTyped :: forall (m :: * -> *). Quote m => Schema -> Code m Schema
$cliftTyped :: forall (m :: * -> *). Quote m => Schema -> Code m Schema
lift :: forall (m :: * -> *). Quote m => Schema -> m Exp
$clift :: forall (m :: * -> *). Quote m => Schema -> m Exp
TH.Lift, Int -> Schema -> ShowS
[Schema] -> ShowS
Schema -> String
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 DeepSeq.NFData Schema where
    rnf :: Schema -> ()
rnf Schema
x = case Schema
x of
        Array Maybe Natural
a Maybe Natural
b Either Schema (NonEmpty Schema)
c Maybe Schema
d -> forall a. NFData a => a -> ()
DeepSeq.rnf (Maybe Natural
a, Maybe Natural
b, Either Schema (NonEmpty Schema)
c, Maybe Schema
d)
        Schema
Boolean -> ()
        Const Value
a -> forall a. NFData a => a -> ()
DeepSeq.rnf Value
a
        Schema
Argo.Internal.Schema.Schema.False -> ()
        Integer Maybe Integer
a Maybe Integer
b -> forall a. NFData a => a -> ()
DeepSeq.rnf (Maybe Integer
a, Maybe Integer
b)
        Schema
Null -> ()
        Schema
Number -> ()
        Object [(Name, Schema)]
a [Name]
b Maybe Schema
c -> forall a. NFData a => a -> ()
DeepSeq.rnf ([(Name, Schema)]
a, [Name]
b, Maybe Schema
c)
        OneOf [Schema]
a -> forall a. NFData a => a -> ()
DeepSeq.rnf [Schema]
a
        Ref Identifier
a -> forall a. NFData a => a -> ()
DeepSeq.rnf Identifier
a
        String Maybe Natural
a Maybe Natural
b -> forall a. NFData a => a -> ()
DeepSeq.rnf (Maybe Natural
a, Maybe Natural
b)
        Schema
Argo.Internal.Schema.Schema.True -> ()

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 forall a b. (a -> b) -> a -> b
$ [Schema]
xs forall a. Semigroup a => a -> a -> a
<> [Schema]
ys
        (OneOf [Schema]
xs, Schema
_) -> [Schema] -> Schema
OneOf forall a b. (a -> b) -> a -> b
$ Schema
y forall a. a -> [a] -> [a]
: [Schema]
xs
        (Schema
_, OneOf [Schema]
ys) -> [Schema] -> Schema
OneOf forall a b. (a -> b) -> a -> b
$ Schema
x 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 :: forall a. String -> a -> Member a
member String
k a
v =
    forall value. (Name, value) -> Member value
Member.fromTuple (String -> Name
Name.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
String.fromText 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) = 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 = (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 = (forall a. a -> Maybe a
Just Identifier
i, Schema
s)