Schema.hs

module Rattletrap.Schema where

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

data Schema = Schema
  { name :: Text.Text
  , json :: Json.Value
  }
  deriving (Eq, Show)

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

ref :: Schema -> Json.Value
ref s = Json.object [Json.pair "$ref" $ Text.pack "#/definitions/" <> name s]

object :: [((Json.Key, Json.Value), Bool)] -> Json.Value
object xs = Json.object
  [ Json.pair "type" "object"
  , Json.pair "properties" . Json.object $ fmap
    ((\(k, v) -> Json.pair (Json.keyToString k) v) . fst)
    xs
  , Json.pair "required" . fmap (fst . fst) $ filter snd xs
  ]

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

oneOf :: [Json.Value] -> Json.Value
oneOf xs = Json.object [Json.pair "oneOf" xs]

tuple :: [Json.Value] -> Json.Value
tuple xs = Json.object
  [ Json.pair "type" "array"
  , Json.pair "items" xs
  , Json.pair "minItems" $ length xs
  , Json.pair "maxItems" $ length xs
  ]

array :: Schema -> Schema
array s = Schema
  { name = Text.pack "array-" <> name s
  , json = Json.object [Json.pair "type" "array", Json.pair "items" $ ref s]
  }

boolean :: Schema
boolean = named "boolean" $ Json.object [Json.pair "type" "boolean"]

integer :: Schema
integer = named "integer" $ Json.object [Json.pair "type" "integer"]

null :: Schema
null = named "null" $ Json.object [Json.pair "type" "null"]

number :: Schema
number = named "number" $ Json.object [Json.pair "type" "number"]

string :: Schema
string = named "string" $ Json.object [Json.pair "type" "string"]