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"]