module Rattletrap.Schema where

import qualified Data.Text as Text
import qualified Rattletrap.Utility.Json as Json

data Schema = Schema
  { Schema -> Text
name :: Text.Text
  , Schema -> Value
json :: Json.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, 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)

named :: String -> Json.Value -> Schema
named :: String -> Value -> Schema
named String
n Value
j = Schema :: Text -> Value -> Schema
Schema { name :: Text
name = String -> Text
Text.pack String
n, json :: Value
json = Value
j }

ref :: Schema -> Json.Value
ref :: Schema -> Value
ref Schema
s = [Pair] -> Value
Json.object [String -> Text -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"$ref" (Text -> Pair) -> Text -> Pair
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"#/definitions/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Schema -> Text
name Schema
s]

object :: [((Text.Text, Json.Value), Bool)] -> Json.Value
object :: [(Pair, Bool)] -> Value
object [(Pair, Bool)]
xs = [Pair] -> Value
Json.object
  [ String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"object"
  , String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"properties" (Value -> Pair) -> ([Pair] -> Value) -> [Pair] -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
Json.object ([Pair] -> Pair) -> [Pair] -> Pair
forall a b. (a -> b) -> a -> b
$ ((Pair, Bool) -> Pair) -> [(Pair, Bool)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pair, Bool) -> Pair
forall a b. (a, b) -> a
fst [(Pair, Bool)]
xs
  , String -> [Text] -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"required" ([Text] -> Pair)
-> ([(Pair, Bool)] -> [Text]) -> [(Pair, Bool)] -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Pair, Bool) -> Text) -> [(Pair, Bool)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pair -> Text
forall a b. (a, b) -> a
fst (Pair -> Text) -> ((Pair, Bool) -> Pair) -> (Pair, Bool) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair, Bool) -> Pair
forall a b. (a, b) -> a
fst) ([(Pair, Bool)] -> Pair) -> [(Pair, Bool)] -> Pair
forall a b. (a -> b) -> a -> b
$ ((Pair, Bool) -> Bool) -> [(Pair, Bool)] -> [(Pair, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Pair, Bool) -> Bool
forall a b. (a, b) -> b
snd [(Pair, Bool)]
xs
  ]

maybe :: Schema -> Schema
maybe :: Schema -> Schema
maybe Schema
s = Schema :: Text -> Value -> Schema
Schema
  { name :: Text
name = String -> Text
Text.pack String
"maybe-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Schema -> Text
name Schema
s
  , json :: Value
json = [Value] -> Value
oneOf [Schema -> Value
ref Schema
s, Schema -> Value
json Schema
Rattletrap.Schema.null]
  }

oneOf :: [Json.Value] -> Json.Value
oneOf :: [Value] -> Value
oneOf [Value]
xs = [Pair] -> Value
Json.object [String -> [Value] -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"oneOf" [Value]
xs]

tuple :: [Json.Value] -> Json.Value
tuple :: [Value] -> Value
tuple [Value]
xs = [Pair] -> Value
Json.object
  [ String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"array"
  , String -> [Value] -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"items" [Value]
xs
  , String -> Int -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"minItems" (Int -> Pair) -> Int -> Pair
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs
  , String -> Int -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"maxItems" (Int -> Pair) -> Int -> Pair
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs
  ]

array :: Schema -> Schema
array :: Schema -> Schema
array Schema
s = Schema :: Text -> Value -> Schema
Schema
  { name :: Text
name = String -> Text
Text.pack String
"array-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Schema -> Text
name Schema
s
  , json :: Value
json = [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"array", String -> Value -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"items" (Value -> Pair) -> Value -> Pair
forall a b. (a -> b) -> a -> b
$ Schema -> Value
ref Schema
s]
  }

boolean :: Schema
boolean :: Schema
boolean = String -> Value -> Schema
named String
"boolean" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"boolean"]

integer :: Schema
integer :: Schema
integer = String -> Value -> Schema
named String
"integer" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"integer"]

null :: Schema
null :: Schema
null = String -> Value -> Schema
named String
"null" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"null"]

number :: Schema
number :: Schema
number = String -> Value -> Schema
named String
"number" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"number"]

string :: Schema
string :: Schema
string = String -> Value -> Schema
named String
"string" (Value -> Schema) -> Value -> Schema
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
Json.object [String -> String -> Pair
forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"string"]