-- | Combinators for creating JSON schemas. module Data.JSON.Schema.Combinators ( SchemaC , (<|>) , (<+>) , merge , field , value , number , array , addField , addFields , empty , enum , unbounded , unboundedLength , nullable ) where import Prelude.Compat import Data.JSON.Schema.Types import Data.Text (Text) import qualified Data.Aeson as Aeson -- | A schema combinator. type SchemaC = Schema -> Schema -- | Optionality operator for schemas. infixl 3 <|> (<|>) :: Schema -> Schema -> Schema (Choice s1) <|> (Choice s2) = Choice $ s1 ++ s2 (Choice s1) <|> v = Choice $ s1 ++ [v] v <|> (Choice s2) = Choice $ v : s2 v1 <|> v2 = Choice $ [v1, v2] -- | Tupling. infixl 4 <+> (<+>) :: Schema -> Schema -> Schema (Tuple t1) <+> (Tuple t2) = Tuple $ t1 ++ t2 (Tuple t1) <+> v = Tuple $ t1 ++ [v] v <+> (Tuple t2) = Tuple $ v : t2 v1 <+> v2 = Tuple $ [v1, v2] -- | If passed two objects, merges the fields. Otherwise creates a -- tuple. merge :: Schema -> Schema -> Schema merge (Object f1) (Object f2) = Object $ f1 ++ f2 merge v1 v2 = v1 <+> v2 -- | Create an object with a single field. field :: Text -> Bool -> Schema -> Schema field k r v = Object [Field k r v] -- | An unbounded string. value :: Schema value = Value unboundedLength -- | An unbounded number. number :: Schema number = Number unbounded -- | An unbounded array with non-unique values. array :: Schema -> Schema array = Array unboundedLength False -- | Add a field to an object, or tuple if passed a non-object. addField :: Text -> Bool -> Schema -> SchemaC addField k r v = merge $ field k r v -- | Add multiple fields to an object, or tuple if passed a -- non-object. addFields :: [(Text, Bool, Schema)] -> SchemaC addFields = flip $ foldr (\(k, r, v) -> addField k r v) -- | An empty object. empty :: Schema empty = Object [] -- | A choice between constant values. enum :: [Aeson.Value] -> Schema enum = Choice . map Constant -- | The provided schema or null. nullable :: Schema -> Schema nullable = (<|> Constant Aeson.Null)