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

module Argo.Schema.Schema where

import qualified Argo.Json.Array as Array
import qualified Argo.Json.Boolean as Boolean
import qualified Argo.Json.Member as Member
import qualified Argo.Json.Name as Name
import qualified Argo.Json.Object as Object
import qualified Argo.Json.String as String
import qualified Argo.Json.Value as Value
import qualified Argo.Vendor.DeepSeq as DeepSeq
import qualified Argo.Vendor.TemplateHaskell as TH
import qualified Argo.Vendor.Text as Text
import qualified GHC.Generics as Generics

-- | A JSON Schema.
-- <https://datatracker.ietf.org/doc/html/draft-handrews-json-schema-01>
newtype Schema
    = Schema Value.Value
    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 = Value -> Schema
fromValue (Value -> Schema)
-> (Object Value -> Value) -> Object Value -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object Value -> Value
Value.Object (Object Value -> Schema) -> Object Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Member Value] -> Object Value
forall value. [Member value] -> Object value
Object.fromList
        [ (Name, Value) -> Member Value
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
"oneOf"
              , Array Value -> Value
Value.Array (Array Value -> Value) -> Array Value -> Value
forall a b. (a -> b) -> a -> b
$ [Value] -> Array Value
forall value. [value] -> Array value
Array.fromList [Schema -> Value
toValue Schema
x, Schema -> Value
toValue Schema
y]
              )
        ]

instance Monoid Schema where
    mempty :: Schema
mempty = Schema
true

fromValue :: Value.Value -> Schema
fromValue :: Value -> Schema
fromValue = Value -> Schema
Schema

toValue :: Schema -> Value.Value
toValue :: Schema -> Value
toValue (Schema Value
x) = Value
x

false :: Schema
false :: Schema
false = Value -> Schema
fromValue (Value -> Schema) -> (Boolean -> Value) -> Boolean -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boolean -> Value
Value.Boolean (Boolean -> Schema) -> Boolean -> Schema
forall a b. (a -> b) -> a -> b
$ Bool -> Boolean
Boolean.fromBool Bool
False

true :: Schema
true :: Schema
true = Value -> Schema
fromValue (Value -> Schema) -> (Boolean -> Value) -> Boolean -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Boolean -> Value
Value.Boolean (Boolean -> Schema) -> Boolean -> Schema
forall a b. (a -> b) -> a -> b
$ Bool -> Boolean
Boolean.fromBool Bool
True