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
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
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 {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 [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"$ref" forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
"#/definitions/" 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
    [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"object",
      forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"properties" forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
Json.object forall a b. (a -> b) -> a -> b
$
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
          ((\(Key
k, Value
v) -> forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair (Key -> String
Json.keyToString Key
k) Value
v) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
          [(Pair, Bool)]
xs,
      forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"required" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter 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-" 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 [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
    [ forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"array",
      forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"items" [Value]
xs,
      forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"minItems" forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
xs,
      forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"maxItems" forall a b. (a -> b) -> a -> b
$ 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-" forall a. Semigroup a => a -> a -> a
<> Schema -> Text
name Schema
s,
      json :: Value
json = [Pair] -> Value
Json.object [forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"type" String
"array", forall value pair.
(ToJSON value, KeyValue pair) =>
String -> value -> pair
Json.pair String
"items" forall a b. (a -> b) -> a -> b
$ Schema -> Value
ref Schema
s]
    }

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