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
$c== :: Schema -> Schema -> Bool
== :: Schema -> Schema -> Bool
$c/= :: Schema -> Schema -> Bool
/= :: 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
$cshowsPrec :: Int -> Schema -> ShowS
showsPrec :: Int -> Schema -> ShowS
$cshow :: Schema -> String
show :: Schema -> String
$cshowList :: [Schema] -> ShowS
showList :: [Schema] -> ShowS
Show)

named :: String -> Json.Value -> Schema
named :: String -> Value -> Schema
named String
n Value
j = 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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 :: [((Json.Key, Json.Value), Bool)] -> Json.Value
object :: [(Pair, Bool)] -> Value
object [(Pair, Bool)]
xs =
  [Pair] -> Value
Json.object
    [ String -> String -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"type" String
"object",
      String -> Value -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ((\(Key
k, Value
v) -> String -> Value -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair (Key -> String
Json.keyToString Key
k) Value
v) (Pair -> Pair) -> ((Pair, Bool) -> Pair) -> (Pair, Bool) -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Pair, Bool) -> Pair
forall a b. (a, b) -> a
fst)
          [(Pair, Bool)]
xs,
      String -> [Key] -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"required" ([Key] -> Pair)
-> ([(Pair, Bool)] -> [Key]) -> [(Pair, Bool)] -> Pair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Pair, Bool) -> Key) -> [(Pair, Bool)] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Pair -> Key
forall a b. (a, b) -> a
fst (Pair -> Key) -> ((Pair, Bool) -> Pair) -> (Pair, Bool) -> Key
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
    { 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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"type" String
"array",
      String -> [Value] -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"items" [Value]
xs,
      String -> Int -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"minItems" (Int -> Pair) -> Int -> Pair
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs,
      String -> Int -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"maxItems" (Int -> Pair) -> Int -> Pair
forall a b. (a -> b) -> a -> b
$ [Value] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs
    ]

array :: Schema -> Schema
array :: Schema -> Schema
array Schema
s =
  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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"type" String
"array", String -> Value -> Pair
forall value e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
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 e p.
(ToJSON value, KeyValue e p) =>
String -> value -> p
Json.pair String
"type" String
"string"]