{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Internal module that provides JSON parser and serializers that convert to OpenAPI documentation.
--
-- Note that this module is full of internal-use-only functions and should probably n ever actually be imported.
module Jordan.OpenAPI.Internal where

import Control.Applicative (Alternative (..))
import Control.Monad (unless, when)
import qualified Data.Aeson.Types as Aeson
import Data.Function (on)
import Data.Functor (void)
import Data.Functor.Contravariant (Contravariant (contramap))
import Data.Functor.Contravariant.Divisible (Divisible (..))
import qualified Data.HashMap.Strict.InsOrd as InsOrd
import Data.Maybe (fromMaybe)
import Data.OpenApi.Declare
import Data.OpenApi.Internal
import Data.OpenApi.Internal.Schema (rename, unname, unnamed)
import Data.OpenApi.Optics
import Data.Proxy (Proxy (..))
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Debug.Trace (trace, traceM, traceShowId)
import GHC.Generics
import GHC.Stack (HasCallStack)
import Jordan.FromJSON.Class
import Jordan.ToJSON.Class
import Network.HTTP.Types.URI (urlEncode)
import Optics.At.Core
import Optics.Iso (non)
import Optics.Operators
import Optics.Optic ((%), (&))

-- | Declare with a phantom type parameter.
newtype ConstDeclare env r a = ConstDeclare {ConstDeclare env r a -> Declare env r
runConstDeclare :: Declare env r}

-- | Fmap ignores argument
instance Functor (ConstDeclare env r) where
  fmap :: (a -> b) -> ConstDeclare env r a -> ConstDeclare env r b
fmap a -> b
_ (ConstDeclare Declare env r
d) = Declare env r -> ConstDeclare env r b
forall env r a. Declare env r -> ConstDeclare env r a
ConstDeclare Declare env r
d

-- | Applicative combines declarations.
instance (Monoid r, Monoid env) => Applicative (ConstDeclare env r) where
  pure :: a -> ConstDeclare env r a
pure a
_ = Declare env r -> ConstDeclare env r a
forall env r a. Declare env r -> ConstDeclare env r a
ConstDeclare (Declare env r -> ConstDeclare env r a)
-> Declare env r -> ConstDeclare env r a
forall a b. (a -> b) -> a -> b
$ r -> Declare env r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
forall a. Monoid a => a
mempty
  (ConstDeclare Declare env r
f) <*> :: ConstDeclare env r (a -> b)
-> ConstDeclare env r a -> ConstDeclare env r b
<*> (ConstDeclare Declare env r
a) = Declare env r -> ConstDeclare env r b
forall env r a. Declare env r -> ConstDeclare env r a
ConstDeclare (Declare env r -> ConstDeclare env r b)
-> Declare env r -> ConstDeclare env r b
forall a b. (a -> b) -> a -> b
$ do
    r
f' <- Declare env r
f
    r
a' <- Declare env r
a
    r -> Declare env r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> Declare env r) -> r -> Declare env r
forall a b. (a -> b) -> a -> b
$ r
f' r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
a'

-- | Contravariant ignores argument.
instance Contravariant (ConstDeclare env r) where
  contramap :: (a -> b) -> ConstDeclare env r b -> ConstDeclare env r a
contramap a -> b
_ (ConstDeclare Declare env r
d) = Declare env r -> ConstDeclare env r a
forall env r a. Declare env r -> ConstDeclare env r a
ConstDeclare Declare env r
d

instance (Monoid r, Monoid env) => Divisible (ConstDeclare env r) where
  divide :: (a -> (b, c))
-> ConstDeclare env r b
-> ConstDeclare env r c
-> ConstDeclare env r a
divide a -> (b, c)
_ (ConstDeclare Declare env r
l) (ConstDeclare Declare env r
r) = Declare env r -> ConstDeclare env r a
forall env r a. Declare env r -> ConstDeclare env r a
ConstDeclare (Declare env r -> ConstDeclare env r a)
-> Declare env r -> ConstDeclare env r a
forall a b. (a -> b) -> a -> b
$ do
    r
l' <- Declare env r
l
    r
r' <- Declare env r
r
    r -> Declare env r
forall (f :: * -> *) a. Applicative f => a -> f a
pure (r -> Declare env r) -> r -> Declare env r
forall a b. (a -> b) -> a -> b
$ r
l' r -> r -> r
forall a. Semigroup a => a -> a -> a
<> r
r'
  conquer :: ConstDeclare env r a
conquer = Declare env r -> ConstDeclare env r a
forall env r a. Declare env r -> ConstDeclare env r a
ConstDeclare (Declare env r -> ConstDeclare env r a)
-> Declare env r -> ConstDeclare env r a
forall a b. (a -> b) -> a -> b
$ r -> Declare env r
forall (f :: * -> *) a. Applicative f => a -> f a
pure r
forall a. Monoid a => a
mempty

data PropertyDeclare = PropertyDeclare
  { PropertyDeclare -> [Text]
requiredProperties :: [T.Text],
    PropertyDeclare -> InsOrdHashMap Text (Referenced Schema)
propertyTypes :: InsOrd.InsOrdHashMap T.Text (Referenced Schema)
  }
  deriving (Int -> PropertyDeclare -> ShowS
[PropertyDeclare] -> ShowS
PropertyDeclare -> String
(Int -> PropertyDeclare -> ShowS)
-> (PropertyDeclare -> String)
-> ([PropertyDeclare] -> ShowS)
-> Show PropertyDeclare
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PropertyDeclare] -> ShowS
$cshowList :: [PropertyDeclare] -> ShowS
show :: PropertyDeclare -> String
$cshow :: PropertyDeclare -> String
showsPrec :: Int -> PropertyDeclare -> ShowS
$cshowsPrec :: Int -> PropertyDeclare -> ShowS
Show, (forall x. PropertyDeclare -> Rep PropertyDeclare x)
-> (forall x. Rep PropertyDeclare x -> PropertyDeclare)
-> Generic PropertyDeclare
forall x. Rep PropertyDeclare x -> PropertyDeclare
forall x. PropertyDeclare -> Rep PropertyDeclare x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PropertyDeclare x -> PropertyDeclare
$cfrom :: forall x. PropertyDeclare -> Rep PropertyDeclare x
Generic)

instance Semigroup PropertyDeclare where
  (PropertyDeclare [Text]
r InsOrdHashMap Text (Referenced Schema)
t) <> :: PropertyDeclare -> PropertyDeclare -> PropertyDeclare
<> (PropertyDeclare [Text]
r' InsOrdHashMap Text (Referenced Schema)
t') =
    [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare
      ([Text]
r [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
r')
      (InsOrdHashMap Text (Referenced Schema)
t InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
-> InsOrdHashMap Text (Referenced Schema)
forall a. Semigroup a => a -> a -> a
<> InsOrdHashMap Text (Referenced Schema)
t')

instance Monoid PropertyDeclare where
  mempty :: PropertyDeclare
mempty = [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare [Text]
forall a. Monoid a => a
mempty InsOrdHashMap Text (Referenced Schema)
forall a. Monoid a => a
mempty

addDescription ::
  T.Text ->
  Referenced Schema ->
  Referenced Schema
addDescription :: Text -> Referenced Schema -> Referenced Schema
addDescription Text
text = \case
  Ref Reference
ref ->
    Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$
      #_schemaDescription ?~ text $
        #_schemaOneOf ?~ [Ref ref] $
          mempty
  Inline Schema
sc -> Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ case Schema
sc Schema
-> Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text)
-> Maybe Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "_schemaDescription"
  (Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text))
Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text)
#_schemaDescription of
    Maybe Text
Nothing -> IsLabel
  "_schemaDescription"
  (Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text))
Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text)
#_schemaDescription Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text)
-> Text -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Text
text (Schema -> Schema) -> Schema -> Schema
forall a b. (a -> b) -> a -> b
$ Schema
sc
    Just Text
txt ->
      #_schemaDescription ?~ text $
        #_schemaOneOf ?~ [Inline sc] $
          mempty

newtype ObjectSchema a = ObjectSchema
  { ObjectSchema a -> Declare (Definitions Schema) PropertyDeclare
getObjectSchema ::
      Declare (Definitions Schema) PropertyDeclare
  }
  deriving (a -> ObjectSchema b -> ObjectSchema a
(a -> b) -> ObjectSchema a -> ObjectSchema b
(forall a b. (a -> b) -> ObjectSchema a -> ObjectSchema b)
-> (forall a b. a -> ObjectSchema b -> ObjectSchema a)
-> Functor ObjectSchema
forall a b. a -> ObjectSchema b -> ObjectSchema a
forall a b. (a -> b) -> ObjectSchema a -> ObjectSchema b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ObjectSchema b -> ObjectSchema a
$c<$ :: forall a b. a -> ObjectSchema b -> ObjectSchema a
fmap :: (a -> b) -> ObjectSchema a -> ObjectSchema b
$cfmap :: forall a b. (a -> b) -> ObjectSchema a -> ObjectSchema b
Functor, Functor ObjectSchema
a -> ObjectSchema a
Functor ObjectSchema
-> (forall a. a -> ObjectSchema a)
-> (forall a b.
    ObjectSchema (a -> b) -> ObjectSchema a -> ObjectSchema b)
-> (forall a b c.
    (a -> b -> c)
    -> ObjectSchema a -> ObjectSchema b -> ObjectSchema c)
-> (forall a b. ObjectSchema a -> ObjectSchema b -> ObjectSchema b)
-> (forall a b. ObjectSchema a -> ObjectSchema b -> ObjectSchema a)
-> Applicative ObjectSchema
ObjectSchema a -> ObjectSchema b -> ObjectSchema b
ObjectSchema a -> ObjectSchema b -> ObjectSchema a
ObjectSchema (a -> b) -> ObjectSchema a -> ObjectSchema b
(a -> b -> c) -> ObjectSchema a -> ObjectSchema b -> ObjectSchema c
forall a. a -> ObjectSchema a
forall a b. ObjectSchema a -> ObjectSchema b -> ObjectSchema a
forall a b. ObjectSchema a -> ObjectSchema b -> ObjectSchema b
forall a b.
ObjectSchema (a -> b) -> ObjectSchema a -> ObjectSchema b
forall a b c.
(a -> b -> c) -> ObjectSchema a -> ObjectSchema b -> ObjectSchema c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ObjectSchema a -> ObjectSchema b -> ObjectSchema a
$c<* :: forall a b. ObjectSchema a -> ObjectSchema b -> ObjectSchema a
*> :: ObjectSchema a -> ObjectSchema b -> ObjectSchema b
$c*> :: forall a b. ObjectSchema a -> ObjectSchema b -> ObjectSchema b
liftA2 :: (a -> b -> c) -> ObjectSchema a -> ObjectSchema b -> ObjectSchema c
$cliftA2 :: forall a b c.
(a -> b -> c) -> ObjectSchema a -> ObjectSchema b -> ObjectSchema c
<*> :: ObjectSchema (a -> b) -> ObjectSchema a -> ObjectSchema b
$c<*> :: forall a b.
ObjectSchema (a -> b) -> ObjectSchema a -> ObjectSchema b
pure :: a -> ObjectSchema a
$cpure :: forall a. a -> ObjectSchema a
$cp1Applicative :: Functor ObjectSchema
Applicative, b -> ObjectSchema b -> ObjectSchema a
(a -> b) -> ObjectSchema b -> ObjectSchema a
(forall a b. (a -> b) -> ObjectSchema b -> ObjectSchema a)
-> (forall b a. b -> ObjectSchema b -> ObjectSchema a)
-> Contravariant ObjectSchema
forall b a. b -> ObjectSchema b -> ObjectSchema a
forall a b. (a -> b) -> ObjectSchema b -> ObjectSchema a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> ObjectSchema b -> ObjectSchema a
$c>$ :: forall b a. b -> ObjectSchema b -> ObjectSchema a
contramap :: (a -> b) -> ObjectSchema b -> ObjectSchema a
$ccontramap :: forall a b. (a -> b) -> ObjectSchema b -> ObjectSchema a
Contravariant, Contravariant ObjectSchema
ObjectSchema a
Contravariant ObjectSchema
-> (forall a b c.
    (a -> (b, c))
    -> ObjectSchema b -> ObjectSchema c -> ObjectSchema a)
-> (forall a. ObjectSchema a)
-> Divisible ObjectSchema
(a -> (b, c)) -> ObjectSchema b -> ObjectSchema c -> ObjectSchema a
forall a. ObjectSchema a
forall a b c.
(a -> (b, c)) -> ObjectSchema b -> ObjectSchema c -> ObjectSchema a
forall (f :: * -> *).
Contravariant f
-> (forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a. f a)
-> Divisible f
conquer :: ObjectSchema a
$cconquer :: forall a. ObjectSchema a
divide :: (a -> (b, c)) -> ObjectSchema b -> ObjectSchema c -> ObjectSchema a
$cdivide :: forall a b c.
(a -> (b, c)) -> ObjectSchema b -> ObjectSchema c -> ObjectSchema a
$cp1Divisible :: Contravariant ObjectSchema
Divisible) via (ConstDeclare (Definitions Schema) PropertyDeclare)

instance JSONObjectParser ObjectSchema where
  parseFieldWithDefault :: Text
-> (forall (valueParser :: * -> *).
    JSONParser valueParser =>
    valueParser a)
-> a
-> ObjectSchema a
parseFieldWithDefault Text
key = \forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
prop a
_ -> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a.
Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
ObjectSchema (Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a)
-> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
prop
    PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare)
-> PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall a b. (a -> b) -> a -> b
$ [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare [Text]
forall a. Monoid a => a
mempty (InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare)
-> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
forall a b. (a -> b) -> a -> b
$ Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrd.singleton Text
key Referenced Schema
r
  parseDescribeFieldWithDefault :: Text
-> Text
-> (forall (valueParser :: * -> *).
    JSONParser valueParser =>
    valueParser a)
-> a
-> ObjectSchema a
parseDescribeFieldWithDefault Text
key Text
description = \forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
prop a
_ -> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a.
Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
ObjectSchema (Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a)
-> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
prop
    PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare)
-> PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall a b. (a -> b) -> a -> b
$ [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare [Text]
forall a. Monoid a => a
mempty (InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare)
-> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
forall a b. (a -> b) -> a -> b
$ Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrd.singleton Text
key (Text -> Referenced Schema -> Referenced Schema
addDescription Text
description Referenced Schema
r)
  parseDescribeFieldWith :: Text
-> Text
-> (forall (valueParser :: * -> *).
    JSONParser valueParser =>
    valueParser a)
-> ObjectSchema a
parseDescribeFieldWith Text
key Text
description = \forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
prop -> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a.
Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
ObjectSchema (Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a)
-> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
prop
    PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare)
-> PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall a b. (a -> b) -> a -> b
$ [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare [Text
Item [Text]
key] (InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare)
-> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
forall a b. (a -> b) -> a -> b
$ Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrd.singleton Text
key (Text -> Referenced Schema -> Referenced Schema
addDescription Text
description Referenced Schema
r)
  parseFieldWith :: Text
-> (forall (valueParser :: * -> *).
    JSONParser valueParser =>
    valueParser a)
-> ObjectSchema a
parseFieldWith Text
t forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
p = Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a.
Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
ObjectSchema (Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a)
-> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
p)
    PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare)
-> PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall a b. (a -> b) -> a -> b
$ [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare [Text
Item [Text]
t] (InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare)
-> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
forall a b. (a -> b) -> a -> b
$ Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrd.singleton Text
t Referenced Schema
r

instance JSONObjectSerializer ObjectSchema where
  serializeFieldWith :: Text
-> (forall (jsonSerializer :: * -> *).
    JSONSerializer jsonSerializer =>
    jsonSerializer a)
-> ObjectSchema a
serializeFieldWith Text
f forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
w = Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a.
Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
ObjectSchema (Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a)
-> Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
w)
    PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare)
-> PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall a b. (a -> b) -> a -> b
$ [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare [Text
Item [Text]
f] (InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare)
-> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
forall a b. (a -> b) -> a -> b
$ Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrd.singleton Text
f Referenced Schema
r
  serializeJust :: Text
-> (forall (jsonSerializer :: * -> *).
    JSONSerializer jsonSerializer =>
    jsonSerializer a)
-> ObjectSchema (Maybe a)
serializeJust Text
f forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
w = Declare (Definitions Schema) PropertyDeclare
-> ObjectSchema (Maybe a)
forall a.
Declare (Definitions Schema) PropertyDeclare -> ObjectSchema a
ObjectSchema (Declare (Definitions Schema) PropertyDeclare
 -> ObjectSchema (Maybe a))
-> Declare (Definitions Schema) PropertyDeclare
-> ObjectSchema (Maybe a)
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
w)
    PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare)
-> PropertyDeclare -> Declare (Definitions Schema) PropertyDeclare
forall a b. (a -> b) -> a -> b
$ [Text] -> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
PropertyDeclare [] (InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare)
-> InsOrdHashMap Text (Referenced Schema) -> PropertyDeclare
forall a b. (a -> b) -> a -> b
$ Text -> Referenced Schema -> InsOrdHashMap Text (Referenced Schema)
forall k v. Hashable k => k -> v -> InsOrdHashMap k v
InsOrd.singleton Text
f Referenced Schema
r

newtype TupleSchema a = TupleSchema
  { TupleSchema a -> Declare (Definitions Schema) [Referenced Schema]
getTupleSchema ::
      Declare (Definitions Schema) [Referenced Schema]
  }
  deriving (a -> TupleSchema b -> TupleSchema a
(a -> b) -> TupleSchema a -> TupleSchema b
(forall a b. (a -> b) -> TupleSchema a -> TupleSchema b)
-> (forall a b. a -> TupleSchema b -> TupleSchema a)
-> Functor TupleSchema
forall a b. a -> TupleSchema b -> TupleSchema a
forall a b. (a -> b) -> TupleSchema a -> TupleSchema b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TupleSchema b -> TupleSchema a
$c<$ :: forall a b. a -> TupleSchema b -> TupleSchema a
fmap :: (a -> b) -> TupleSchema a -> TupleSchema b
$cfmap :: forall a b. (a -> b) -> TupleSchema a -> TupleSchema b
Functor, Functor TupleSchema
a -> TupleSchema a
Functor TupleSchema
-> (forall a. a -> TupleSchema a)
-> (forall a b.
    TupleSchema (a -> b) -> TupleSchema a -> TupleSchema b)
-> (forall a b c.
    (a -> b -> c) -> TupleSchema a -> TupleSchema b -> TupleSchema c)
-> (forall a b. TupleSchema a -> TupleSchema b -> TupleSchema b)
-> (forall a b. TupleSchema a -> TupleSchema b -> TupleSchema a)
-> Applicative TupleSchema
TupleSchema a -> TupleSchema b -> TupleSchema b
TupleSchema a -> TupleSchema b -> TupleSchema a
TupleSchema (a -> b) -> TupleSchema a -> TupleSchema b
(a -> b -> c) -> TupleSchema a -> TupleSchema b -> TupleSchema c
forall a. a -> TupleSchema a
forall a b. TupleSchema a -> TupleSchema b -> TupleSchema a
forall a b. TupleSchema a -> TupleSchema b -> TupleSchema b
forall a b. TupleSchema (a -> b) -> TupleSchema a -> TupleSchema b
forall a b c.
(a -> b -> c) -> TupleSchema a -> TupleSchema b -> TupleSchema c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: TupleSchema a -> TupleSchema b -> TupleSchema a
$c<* :: forall a b. TupleSchema a -> TupleSchema b -> TupleSchema a
*> :: TupleSchema a -> TupleSchema b -> TupleSchema b
$c*> :: forall a b. TupleSchema a -> TupleSchema b -> TupleSchema b
liftA2 :: (a -> b -> c) -> TupleSchema a -> TupleSchema b -> TupleSchema c
$cliftA2 :: forall a b c.
(a -> b -> c) -> TupleSchema a -> TupleSchema b -> TupleSchema c
<*> :: TupleSchema (a -> b) -> TupleSchema a -> TupleSchema b
$c<*> :: forall a b. TupleSchema (a -> b) -> TupleSchema a -> TupleSchema b
pure :: a -> TupleSchema a
$cpure :: forall a. a -> TupleSchema a
$cp1Applicative :: Functor TupleSchema
Applicative, b -> TupleSchema b -> TupleSchema a
(a -> b) -> TupleSchema b -> TupleSchema a
(forall a b. (a -> b) -> TupleSchema b -> TupleSchema a)
-> (forall b a. b -> TupleSchema b -> TupleSchema a)
-> Contravariant TupleSchema
forall b a. b -> TupleSchema b -> TupleSchema a
forall a b. (a -> b) -> TupleSchema b -> TupleSchema a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> TupleSchema b -> TupleSchema a
$c>$ :: forall b a. b -> TupleSchema b -> TupleSchema a
contramap :: (a -> b) -> TupleSchema b -> TupleSchema a
$ccontramap :: forall a b. (a -> b) -> TupleSchema b -> TupleSchema a
Contravariant, Contravariant TupleSchema
TupleSchema a
Contravariant TupleSchema
-> (forall a b c.
    (a -> (b, c)) -> TupleSchema b -> TupleSchema c -> TupleSchema a)
-> (forall a. TupleSchema a)
-> Divisible TupleSchema
(a -> (b, c)) -> TupleSchema b -> TupleSchema c -> TupleSchema a
forall a. TupleSchema a
forall a b c.
(a -> (b, c)) -> TupleSchema b -> TupleSchema c -> TupleSchema a
forall (f :: * -> *).
Contravariant f
-> (forall a b c. (a -> (b, c)) -> f b -> f c -> f a)
-> (forall a. f a)
-> Divisible f
conquer :: TupleSchema a
$cconquer :: forall a. TupleSchema a
divide :: (a -> (b, c)) -> TupleSchema b -> TupleSchema c -> TupleSchema a
$cdivide :: forall a b c.
(a -> (b, c)) -> TupleSchema b -> TupleSchema c -> TupleSchema a
$cp1Divisible :: Contravariant TupleSchema
Divisible) via (ConstDeclare (Definitions Schema) [Referenced Schema])

instance JSONTupleParser TupleSchema where
  consumeItemWith :: (forall (valueParser :: * -> *).
 JSONParser valueParser =>
 valueParser a)
-> TupleSchema a
consumeItemWith forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
p = Declare (Definitions Schema) [Referenced Schema] -> TupleSchema a
forall a.
Declare (Definitions Schema) [Referenced Schema] -> TupleSchema a
TupleSchema (Declare (Definitions Schema) [Referenced Schema] -> TupleSchema a)
-> Declare (Definitions Schema) [Referenced Schema]
-> TupleSchema a
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (valueParser :: * -> *).
JSONParser valueParser =>
valueParser a
p
    [Referenced Schema]
-> Declare (Definitions Schema) [Referenced Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item [Referenced Schema]
Referenced Schema
r]

newtype JSONSchema a = JSONSchema
  { JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema :: Declare (Definitions Schema) NamedSchema
  }
  deriving (a -> JSONSchema b -> JSONSchema a
(a -> b) -> JSONSchema a -> JSONSchema b
(forall a b. (a -> b) -> JSONSchema a -> JSONSchema b)
-> (forall a b. a -> JSONSchema b -> JSONSchema a)
-> Functor JSONSchema
forall a b. a -> JSONSchema b -> JSONSchema a
forall a b. (a -> b) -> JSONSchema a -> JSONSchema b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> JSONSchema b -> JSONSchema a
$c<$ :: forall a b. a -> JSONSchema b -> JSONSchema a
fmap :: (a -> b) -> JSONSchema a -> JSONSchema b
$cfmap :: forall a b. (a -> b) -> JSONSchema a -> JSONSchema b
Functor, b -> JSONSchema b -> JSONSchema a
(a -> b) -> JSONSchema b -> JSONSchema a
(forall a b. (a -> b) -> JSONSchema b -> JSONSchema a)
-> (forall b a. b -> JSONSchema b -> JSONSchema a)
-> Contravariant JSONSchema
forall b a. b -> JSONSchema b -> JSONSchema a
forall a b. (a -> b) -> JSONSchema b -> JSONSchema a
forall (f :: * -> *).
(forall a b. (a -> b) -> f b -> f a)
-> (forall b a. b -> f b -> f a) -> Contravariant f
>$ :: b -> JSONSchema b -> JSONSchema a
$c>$ :: forall b a. b -> JSONSchema b -> JSONSchema a
contramap :: (a -> b) -> JSONSchema b -> JSONSchema a
$ccontramap :: forall a b. (a -> b) -> JSONSchema b -> JSONSchema a
Contravariant) via (ConstDeclare (Definitions Schema) NamedSchema)

instance Semigroup (JSONSchema a) where
  JSONSchema a
a <> :: JSONSchema a -> JSONSchema a -> JSONSchema a
<> JSONSchema a
b =
    Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> (DeclareT (Definitions Schema) Identity Schema
    -> Declare (Definitions Schema) NamedSchema)
-> DeclareT (Definitions Schema) Identity Schema
-> JSONSchema a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> NamedSchema)
-> DeclareT (Definitions Schema) Identity Schema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> NamedSchema
unnamed (DeclareT (Definitions Schema) Identity Schema -> JSONSchema a)
-> DeclareT (Definitions Schema) Identity Schema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$
      Referenced Schema -> Referenced Schema -> Schema
combineSchemas (Referenced Schema -> Referenced Schema -> Schema)
-> Declare (Definitions Schema) (Referenced Schema)
-> DeclareT
     (Definitions Schema) Identity (Referenced Schema -> Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
a) DeclareT
  (Definitions Schema) Identity (Referenced Schema -> Schema)
-> Declare (Definitions Schema) (Referenced Schema)
-> DeclareT (Definitions Schema) Identity Schema
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
b)

instance Selectable JSONSchema where
  giveUp :: (arg -> Void) -> JSONSchema arg
giveUp = (arg -> Void) -> JSONSchema arg
forall a. Monoid a => a
mempty
  select :: (arg -> Either lhs rhs)
-> JSONSchema lhs -> JSONSchema rhs -> JSONSchema arg
select arg -> Either lhs rhs
_ (JSONSchema Declare (Definitions Schema) NamedSchema
lhs) (JSONSchema Declare (Definitions Schema) NamedSchema
rhs) = Declare (Definitions Schema) NamedSchema -> JSONSchema arg
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema Declare (Definitions Schema) NamedSchema
lhs JSONSchema arg -> JSONSchema arg -> JSONSchema arg
forall a. Semigroup a => a -> a -> a
<> Declare (Definitions Schema) NamedSchema -> JSONSchema arg
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema Declare (Definitions Schema) NamedSchema
rhs

-- | Empty instance: must be both a boolean and a text value, which is not possible (obviously!)
instance Monoid (JSONSchema a) where
  mempty :: JSONSchema a
mempty = Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$ do
    NamedSchema
t <- JSONSchema Text -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema Text
forall (f :: * -> *). JSONParser f => f Text
parseText
    NamedSchema
b <- JSONSchema Bool -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema Bool
forall (f :: * -> *). JSONParser f => f Bool
parseBool
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema -> NamedSchema
unnamed (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ (IsLabel
  "_schemaAllOf"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe [Referenced Schema])
     (Maybe [Referenced Schema]))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
#_schemaAllOf Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
-> [Referenced Schema] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ NamedSchema -> Schema
_namedSchemaSchema NamedSchema
t, Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema) -> Schema -> Referenced Schema
forall a b. (a -> b) -> a -> b
$ NamedSchema -> Schema
_namedSchemaSchema NamedSchema
b]) Schema
forall a. Monoid a => a
mempty

sameTypes :: Schema -> Schema -> Bool
sameTypes :: Schema -> Schema -> Bool
sameTypes = Maybe OpenApiType -> Maybe OpenApiType -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Maybe OpenApiType -> Maybe OpenApiType -> Bool)
-> (Schema -> Maybe OpenApiType) -> Schema -> Schema -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Schema
-> Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> Maybe OpenApiType
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType)

bothHaveEnum :: Schema -> Schema -> Bool
bothHaveEnum :: Schema -> Schema -> Bool
bothHaveEnum Schema
a Schema
b = Schema -> [Value]
enumValues Schema
a [Value] -> [Value] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] Bool -> Bool -> Bool
&& Schema -> [Value]
enumValues Schema
b [Value] -> [Value] -> Bool
forall a. Eq a => a -> a -> Bool
/= []

enumValues :: Schema -> [Value]
enumValues = (Schema -> Optic' A_Lens NoIx Schema [Value] -> [Value]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "_schemaEnum"
  (Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value]))
Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value])
#_schemaEnum Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value])
-> Optic
     An_Iso NoIx (Maybe [Value]) (Maybe [Value]) [Value] [Value]
-> Optic' A_Lens NoIx Schema [Value]
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% [Value]
-> Optic
     An_Iso NoIx (Maybe [Value]) (Maybe [Value]) [Value] [Value]
forall a. Eq a => a -> Iso' (Maybe a) a
non [])

combineInline :: Schema -> Schema -> Schema
combineInline :: Schema -> Schema -> Schema
combineInline Schema
a Schema
b
  | Schema -> Schema -> Bool
sameTypes Schema
a Schema
b Bool -> Bool -> Bool
&& Schema -> Schema -> Bool
bothHaveEnum Schema
a Schema
b = (IsLabel
  "_schemaEnum"
  (Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value]))
Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value])
#_schemaEnum Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value])
-> [Value] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ (Schema -> [Value]
enumValues Schema
a [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> Schema -> [Value]
enumValues Schema
b)) Schema
a
  | Bool
otherwise =
    (IsLabel
  "_schemaOneOf"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe [Referenced Schema])
     (Maybe [Referenced Schema]))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
#_schemaOneOf Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
-> [Referenced Schema] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Referenced Schema]
-> Maybe [Referenced Schema] -> [Referenced Schema]
forall a. a -> Maybe a -> a
fromMaybe [Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
a] (Schema -> Maybe [Referenced Schema]
_schemaOneOf Schema
a) [Referenced Schema] -> [Referenced Schema] -> [Referenced Schema]
forall a. Semigroup a => a -> a -> a
<> [Referenced Schema]
-> Maybe [Referenced Schema] -> [Referenced Schema]
forall a. a -> Maybe a -> a
fromMaybe [Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
b] (Schema -> Maybe [Referenced Schema]
_schemaOneOf Schema
b)) Schema
forall a. Monoid a => a
mempty

combineSchemas :: Referenced Schema -> Referenced Schema -> Schema
combineSchemas :: Referenced Schema -> Referenced Schema -> Schema
combineSchemas = ((Referenced Schema, Referenced Schema) -> Schema)
-> Referenced Schema -> Referenced Schema -> Schema
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((Referenced Schema, Referenced Schema) -> Schema)
 -> Referenced Schema -> Referenced Schema -> Schema)
-> ((Referenced Schema, Referenced Schema) -> Schema)
-> Referenced Schema
-> Referenced Schema
-> Schema
forall a b. (a -> b) -> a -> b
$ \case
  (Inline Schema
a, Inline Schema
b) -> Schema -> Schema -> Schema
combineInline Schema
a Schema
b
  (Inline Schema
a, Ref Reference
b) ->
    (IsLabel
  "_schemaOneOf"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe [Referenced Schema])
     (Maybe [Referenced Schema]))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
#_schemaOneOf Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
-> [Referenced Schema] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Referenced Schema]
-> Maybe [Referenced Schema] -> [Referenced Schema]
forall a. a -> Maybe a -> a
fromMaybe [Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
a] (Schema -> Maybe [Referenced Schema]
_schemaOneOf Schema
a) [Referenced Schema] -> [Referenced Schema] -> [Referenced Schema]
forall a. Semigroup a => a -> a -> a
<> [Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref Reference
b]) Schema
forall a. Monoid a => a
mempty
  (Ref Reference
a, Inline Schema
b) ->
    (IsLabel
  "_schemaOneOf"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe [Referenced Schema])
     (Maybe [Referenced Schema]))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
#_schemaOneOf Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
-> [Referenced Schema] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref Reference
a] [Referenced Schema] -> [Referenced Schema] -> [Referenced Schema]
forall a. Semigroup a => a -> a -> a
<> [Referenced Schema]
-> Maybe [Referenced Schema] -> [Referenced Schema]
forall a. a -> Maybe a -> a
fromMaybe [Schema -> Referenced Schema
forall a. a -> Referenced a
Inline Schema
b] (Schema -> Maybe [Referenced Schema]
_schemaOneOf Schema
b)) Schema
forall a. Monoid a => a
mempty
  (Ref Reference
a, Ref Reference
b) -> (IsLabel
  "_schemaOneOf"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe [Referenced Schema])
     (Maybe [Referenced Schema]))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
#_schemaOneOf Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe [Referenced Schema])
  (Maybe [Referenced Schema])
-> [Referenced Schema] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref Reference
a, Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref Reference
b]) Schema
forall a. Monoid a => a
mempty

getJSONRef ::
  forall a.
  FromJSON a =>
  Proxy a ->
  Declare (Definitions Schema) (Referenced Schema)
getJSONRef :: Proxy a -> Declare (Definitions Schema) (Referenced Schema)
getJSONRef = Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> Proxy a
-> Declare (Definitions Schema) (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
FromJSON a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
getFromNamed

getRefDef ::
  Declare (Definitions Schema) NamedSchema ->
  Declare (Definitions Schema) (Referenced Schema)
getRefDef :: Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef Declare (Definitions Schema) NamedSchema
decl = case Declare (Definitions Schema) NamedSchema -> NamedSchema
forall d a. Monoid d => Declare d a -> a
undeclare Declare (Definitions Schema) NamedSchema
decl of
  NamedSchema (Just Text
name) Schema
schema -> do
    Bool
known <- (Definitions Schema -> Bool)
-> DeclareT (Definitions Schema) Identity Bool
forall d (m :: * -> *) a. MonadDeclare d m => (d -> a) -> m a
looks (Text -> Definitions Schema -> Bool
forall k a. (Eq k, Hashable k) => k -> InsOrdHashMap k a -> Bool
InsOrd.member Text
name)
    Bool
-> DeclareT (Definitions Schema) Identity ()
-> DeclareT (Definitions Schema) Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
known (DeclareT (Definitions Schema) Identity ()
 -> DeclareT (Definitions Schema) Identity ())
-> DeclareT (Definitions Schema) Identity ()
-> DeclareT (Definitions Schema) Identity ()
forall a b. (a -> b) -> a -> b
$ do
      Definitions Schema -> DeclareT (Definitions Schema) Identity ()
forall d (m :: * -> *). MonadDeclare d m => d -> m ()
declare [(Text
name, Schema
schema)]
      Declare (Definitions Schema) NamedSchema
-> DeclareT (Definitions Schema) Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Declare (Definitions Schema) NamedSchema
decl
    Referenced Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall (m :: * -> *) a. Monad m => a -> m a
return (Referenced Schema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Referenced Schema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Reference -> Referenced Schema
forall a. Reference -> Referenced a
Ref (Text -> Reference
Reference Text
name)
  NamedSchema
_ -> Schema -> Referenced Schema
forall a. a -> Referenced a
Inline (Schema -> Referenced Schema)
-> (NamedSchema -> Schema) -> NamedSchema -> Referenced Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedSchema -> Optic' A_Lens NoIx NamedSchema Schema -> Schema
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "_namedSchemaSchema" (Optic' A_Lens NoIx NamedSchema Schema)
Optic' A_Lens NoIx NamedSchema Schema
#_namedSchemaSchema) (NamedSchema -> Referenced Schema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Declare (Definitions Schema) NamedSchema
decl

onlyUnnamed :: Schema -> JSONSchema a
onlyUnnamed :: Schema -> JSONSchema a
onlyUnnamed Schema
a = Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$ NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing Schema
a

encodeRefName :: T.Text -> T.Text
encodeRefName :: Text -> Text
encodeRefName = ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Text -> ByteString) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlEncode Bool
False (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

instance JSONTupleSerializer TupleSchema where
  serializeItemWith :: (forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> TupleSchema a
serializeItemWith forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
s = Declare (Definitions Schema) [Referenced Schema] -> TupleSchema a
forall a.
Declare (Definitions Schema) [Referenced Schema] -> TupleSchema a
TupleSchema (Declare (Definitions Schema) [Referenced Schema] -> TupleSchema a)
-> Declare (Definitions Schema) [Referenced Schema]
-> TupleSchema a
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
s
    [Referenced Schema]
-> Declare (Definitions Schema) [Referenced Schema]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Item [Referenced Schema]
Referenced Schema
r]

instance JSONParser JSONSchema where
  parseObject :: (forall (objectParser :: * -> *).
 JSONObjectParser objectParser =>
 objectParser a)
-> JSONSchema a
parseObject forall (objectParser :: * -> *).
JSONObjectParser objectParser =>
objectParser a
f = Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$ do
    PropertyDeclare
d <- ObjectSchema a -> Declare (Definitions Schema) PropertyDeclare
forall a.
ObjectSchema a -> Declare (Definitions Schema) PropertyDeclare
getObjectSchema ObjectSchema a
forall (objectParser :: * -> *).
JSONObjectParser objectParser =>
objectParser a
f
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject)
            (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaProperties"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (InsOrdHashMap Text (Referenced Schema))
     (InsOrdHashMap Text (Referenced Schema)))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (InsOrdHashMap Text (Referenced Schema))
  (InsOrdHashMap Text (Referenced Schema))
#_schemaProperties Optic
  A_Lens
  NoIx
  Schema
  Schema
  (InsOrdHashMap Text (Referenced Schema))
  (InsOrdHashMap Text (Referenced Schema))
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (PropertyDeclare
d PropertyDeclare
-> Optic'
     A_Lens
     NoIx
     PropertyDeclare
     (InsOrdHashMap Text (Referenced Schema))
-> InsOrdHashMap Text (Referenced Schema)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "propertyTypes"
  (Optic'
     A_Lens
     NoIx
     PropertyDeclare
     (InsOrdHashMap Text (Referenced Schema)))
Optic'
  A_Lens
  NoIx
  PropertyDeclare
  (InsOrdHashMap Text (Referenced Schema))
#propertyTypes))
            (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaRequired" (Optic A_Lens NoIx Schema Schema [Text] [Text])
Optic A_Lens NoIx Schema Schema [Text] [Text]
#_schemaRequired Optic A_Lens NoIx Schema Schema [Text] [Text]
-> [Text] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (PropertyDeclare
d PropertyDeclare
-> Optic' A_Lens NoIx PropertyDeclare [Text] -> [Text]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "requiredProperties" (Optic' A_Lens NoIx PropertyDeclare [Text])
Optic' A_Lens NoIx PropertyDeclare [Text]
#requiredProperties))
  parseDictionary :: (forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> JSONSchema [(Text, a)]
parseDictionary forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
inner = Declare (Definitions Schema) NamedSchema -> JSONSchema [(Text, a)]
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema
 -> JSONSchema [(Text, a)])
-> Declare (Definitions Schema) NamedSchema
-> JSONSchema [(Text, a)]
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
inner)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Schema -> NamedSchema
unnamed (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        ( (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject)
            (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaAdditionalProperties"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe AdditionalProperties)
     (Maybe AdditionalProperties))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe AdditionalProperties)
  (Maybe AdditionalProperties)
#_schemaAdditionalProperties Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe AdditionalProperties)
  (Maybe AdditionalProperties)
-> AdditionalProperties -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> AdditionalProperties
AdditionalPropertiesSchema Referenced Schema
r)
        )
          Schema
forall a. Monoid a => a
mempty
  parseTuple :: (forall (arrayParser :: * -> *).
 JSONTupleParser arrayParser =>
 arrayParser o)
-> JSONSchema o
parseTuple forall (arrayParser :: * -> *).
JSONTupleParser arrayParser =>
arrayParser o
parser = Declare (Definitions Schema) NamedSchema -> JSONSchema o
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema o)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema o
forall a b. (a -> b) -> a -> b
$ do
    [Referenced Schema]
items <- TupleSchema o -> Declare (Definitions Schema) [Referenced Schema]
forall a.
TupleSchema a -> Declare (Definitions Schema) [Referenced Schema]
getTupleSchema TupleSchema o
forall (arrayParser :: * -> *).
JSONTupleParser arrayParser =>
arrayParser o
parser
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Schema
forall a. Monoid a => a
mempty
        Schema -> (Schema -> NamedSchema) -> NamedSchema
forall a b. a -> (a -> b) -> b
& ( Schema -> NamedSchema
unnamed
              (Schema -> NamedSchema)
-> (Schema -> Schema) -> Schema -> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiArray)
              (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaItems"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe OpenApiItems)
     (Maybe OpenApiItems))
Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
#_schemaItems Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
-> OpenApiItems -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Referenced Schema] -> OpenApiItems
OpenApiItemsArray [Referenced Schema]
items)
          )
  parseArrayWith :: (forall (jsonParser :: * -> *).
 JSONParser jsonParser =>
 jsonParser a)
-> JSONSchema [a]
parseArrayWith forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
p = Declare (Definitions Schema) NamedSchema -> JSONSchema [a]
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema [a])
-> Declare (Definitions Schema) NamedSchema -> JSONSchema [a]
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
itemRef <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (jsonParser :: * -> *).
JSONParser jsonParser =>
jsonParser a
p)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      ( Schema -> NamedSchema
unnamed
          (Schema -> NamedSchema)
-> (Schema -> Schema) -> Schema -> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiArray)
          (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaItems"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe OpenApiItems)
     (Maybe OpenApiItems))
Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
#_schemaItems Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
-> OpenApiItems -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> OpenApiItems
OpenApiItemsObject Referenced Schema
itemRef)
      )
        Schema
forall a. Monoid a => a
mempty
  parseArray ::
    forall a.
    (FromJSON a) =>
    JSONSchema [a]
  parseArray :: JSONSchema [a]
parseArray = Declare (Definitions Schema) NamedSchema -> JSONSchema [a]
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema [a])
-> Declare (Definitions Schema) NamedSchema -> JSONSchema [a]
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
itemRef <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
FromJSON a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
getFromNamed (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      ( Schema -> NamedSchema
unnamed
          (Schema -> NamedSchema)
-> (Schema -> Schema) -> Schema -> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiArray)
          (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaItems"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe OpenApiItems)
     (Maybe OpenApiItems))
Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
#_schemaItems Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
-> OpenApiItems -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> OpenApiItems
OpenApiItemsObject Referenced Schema
itemRef)
      )
        Schema
forall a. Monoid a => a
mempty
  parseNumber :: JSONSchema Scientific
parseNumber = Schema -> JSONSchema Scientific
forall a. Schema -> JSONSchema a
onlyUnnamed (Schema -> JSONSchema Scientific)
-> Schema -> JSONSchema Scientific
forall a b. (a -> b) -> a -> b
$ (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiNumber) Schema
forall a. Monoid a => a
mempty
  parseInteger :: JSONSchema Integer
parseInteger = Schema -> JSONSchema Integer
forall a. Schema -> JSONSchema a
onlyUnnamed (Schema -> JSONSchema Integer) -> Schema -> JSONSchema Integer
forall a b. (a -> b) -> a -> b
$ (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiInteger) Schema
forall a. Monoid a => a
mempty
  parseTextConstant :: Text -> JSONSchema ()
parseTextConstant Text
t =
    JSONSchema Any -> JSONSchema ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (JSONSchema Any -> JSONSchema ())
-> (Schema -> JSONSchema Any) -> Schema -> JSONSchema ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Schema -> JSONSchema Any
forall a. Schema -> JSONSchema a
onlyUnnamed
      (Schema -> JSONSchema Any)
-> (Schema -> Schema) -> Schema -> JSONSchema Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString)
      (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaEnum"
  (Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value]))
Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value])
#_schemaEnum Optic A_Lens NoIx Schema Schema (Maybe [Value]) (Maybe [Value])
-> [Value] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Text -> Value
Aeson.String Text
t])
      (Schema -> JSONSchema ()) -> Schema -> JSONSchema ()
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
  parseNull :: JSONSchema ()
parseNull = Schema -> JSONSchema ()
forall a. Schema -> JSONSchema a
onlyUnnamed (Schema -> JSONSchema ()) -> Schema -> JSONSchema ()
forall a b. (a -> b) -> a -> b
$ (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiNull) Schema
forall a. Monoid a => a
mempty
  parseText :: JSONSchema Text
parseText = Schema -> JSONSchema Text
forall a. Schema -> JSONSchema a
onlyUnnamed (Schema -> JSONSchema Text) -> Schema -> JSONSchema Text
forall a b. (a -> b) -> a -> b
$ (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiString) Schema
forall a. Monoid a => a
mempty
  parseBool :: JSONSchema Bool
parseBool = Schema -> JSONSchema Bool
forall a. Schema -> JSONSchema a
onlyUnnamed (Schema -> JSONSchema Bool) -> Schema -> JSONSchema Bool
forall a b. (a -> b) -> a -> b
$ (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiBoolean) Schema
forall a. Monoid a => a
mempty
  validateJSON :: JSONSchema (Either Text a) -> JSONSchema a
validateJSON (JSONSchema Declare (Definitions Schema) NamedSchema
d) = Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema Declare (Definitions Schema) NamedSchema
d
  nameParser :: Text -> JSONSchema a -> JSONSchema a
nameParser Text
name = \JSONSchema a
schema -> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$ do
    (NamedSchema Maybe Text
_ Schema
schema) <- JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
schema
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
encodeRefName Text
name) Schema
schema
  addFormat :: Text -> JSONSchema a -> JSONSchema a
addFormat Text
format =
    Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema
      (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> (JSONSchema a -> Declare (Definitions Schema) NamedSchema)
-> JSONSchema a
-> JSONSchema a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedSchema -> NamedSchema)
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
        (IsLabel
  "_namedSchemaSchema" (Optic' A_Lens NoIx NamedSchema Schema)
Optic' A_Lens NoIx NamedSchema Schema
#_namedSchemaSchema Optic' A_Lens NoIx NamedSchema Schema
-> Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text)
-> Optic
     A_Lens NoIx NamedSchema NamedSchema (Maybe Text) (Maybe Text)
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IsLabel
  "_schemaFormat"
  (Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text))
Optic A_Lens NoIx Schema Schema (Maybe Text) (Maybe Text)
#_schemaFormat Optic A_Lens NoIx NamedSchema NamedSchema (Maybe Text) (Maybe Text)
-> Text -> NamedSchema -> NamedSchema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Text
format)
      (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) NamedSchema)
-> (JSONSchema a -> Declare (Definitions Schema) NamedSchema)
-> JSONSchema a
-> Declare (Definitions Schema) NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema

instance JSONSerializer JSONSchema where
  serializeObject :: (forall (objSerializer :: * -> *).
 JSONObjectSerializer objSerializer =>
 objSerializer a)
-> JSONSchema a
serializeObject forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a
f = Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$ do
    PropertyDeclare
d <- ObjectSchema a -> Declare (Definitions Schema) PropertyDeclare
forall a.
ObjectSchema a -> Declare (Definitions Schema) PropertyDeclare
getObjectSchema ObjectSchema a
forall (objSerializer :: * -> *).
JSONObjectSerializer objSerializer =>
objSerializer a
f
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Maybe Text -> Schema -> NamedSchema
NamedSchema Maybe Text
forall a. Maybe a
Nothing (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        Schema
forall a. Monoid a => a
mempty
          Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject)
            (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaProperties"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (InsOrdHashMap Text (Referenced Schema))
     (InsOrdHashMap Text (Referenced Schema)))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (InsOrdHashMap Text (Referenced Schema))
  (InsOrdHashMap Text (Referenced Schema))
#_schemaProperties Optic
  A_Lens
  NoIx
  Schema
  Schema
  (InsOrdHashMap Text (Referenced Schema))
  (InsOrdHashMap Text (Referenced Schema))
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (PropertyDeclare
d PropertyDeclare
-> Optic'
     A_Lens
     NoIx
     PropertyDeclare
     (InsOrdHashMap Text (Referenced Schema))
-> InsOrdHashMap Text (Referenced Schema)
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "propertyTypes"
  (Optic'
     A_Lens
     NoIx
     PropertyDeclare
     (InsOrdHashMap Text (Referenced Schema)))
Optic'
  A_Lens
  NoIx
  PropertyDeclare
  (InsOrdHashMap Text (Referenced Schema))
#propertyTypes))
            (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaRequired" (Optic A_Lens NoIx Schema Schema [Text] [Text])
Optic A_Lens NoIx Schema Schema [Text] [Text]
#_schemaRequired Optic A_Lens NoIx Schema Schema [Text] [Text]
-> [Text] -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a b -> b -> s -> t
.~ (PropertyDeclare
d PropertyDeclare
-> Optic' A_Lens NoIx PropertyDeclare [Text] -> [Text]
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. IsLabel
  "requiredProperties" (Optic' A_Lens NoIx PropertyDeclare [Text])
Optic' A_Lens NoIx PropertyDeclare [Text]
#requiredProperties))
  serializeTuple :: (forall (tupleSerializer :: * -> *).
 JSONTupleSerializer tupleSerializer =>
 tupleSerializer a)
-> JSONSchema a
serializeTuple forall (tupleSerializer :: * -> *).
JSONTupleSerializer tupleSerializer =>
tupleSerializer a
t = Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$ do
    [Referenced Schema]
items <- TupleSchema a -> Declare (Definitions Schema) [Referenced Schema]
forall a.
TupleSchema a -> Declare (Definitions Schema) [Referenced Schema]
getTupleSchema TupleSchema a
forall (tupleSerializer :: * -> *).
JSONTupleSerializer tupleSerializer =>
tupleSerializer a
t
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      ( Schema -> NamedSchema
unnamed
          (Schema -> NamedSchema)
-> (Schema -> Schema) -> Schema -> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiArray)
          (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaItems"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe OpenApiItems)
     (Maybe OpenApiItems))
Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
#_schemaItems Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
-> OpenApiItems -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ [Referenced Schema] -> OpenApiItems
OpenApiItemsArray [Referenced Schema]
items)
      )
        Schema
forall a. Monoid a => a
mempty
  serializeArray :: forall a. (ToJSON a) => JSONSchema [a]
  serializeArray :: JSONSchema [a]
serializeArray = Declare (Definitions Schema) NamedSchema -> JSONSchema [a]
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema [a])
-> Declare (Definitions Schema) NamedSchema -> JSONSchema [a]
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
itemRef <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
forall a b. (a -> b) -> a -> b
$ Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToJSON a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
getToNamed (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      ( Schema -> NamedSchema
unnamed
          (Schema -> NamedSchema)
-> (Schema -> Schema) -> Schema -> NamedSchema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiArray)
          (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaItems"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe OpenApiItems)
     (Maybe OpenApiItems))
Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
#_schemaItems Optic
  A_Lens NoIx Schema Schema (Maybe OpenApiItems) (Maybe OpenApiItems)
-> OpenApiItems -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> OpenApiItems
OpenApiItemsObject Referenced Schema
itemRef)
      )
        Schema
forall a. Monoid a => a
mempty
  serializeText :: JSONSchema Text
serializeText = JSONSchema Text
forall (f :: * -> *). JSONParser f => f Text
parseText
  serializeBool :: JSONSchema Bool
serializeBool = JSONSchema Bool
forall (f :: * -> *). JSONParser f => f Bool
parseBool
  serializeNumber :: JSONSchema Scientific
serializeNumber = JSONSchema Scientific
forall (f :: * -> *). JSONParser f => f Scientific
parseNumber
  serializeDictionary :: (forall (jsonSerializer :: * -> *).
 JSONSerializer jsonSerializer =>
 jsonSerializer a)
-> JSONSchema (t (Text, a))
serializeDictionary forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
ser = Declare (Definitions Schema) NamedSchema
-> JSONSchema (t (Text, a))
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema
 -> JSONSchema (t (Text, a)))
-> Declare (Definitions Schema) NamedSchema
-> JSONSchema (t (Text, a))
forall a b. (a -> b) -> a -> b
$ do
    Referenced Schema
r <- Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
forall (jsonSerializer :: * -> *).
JSONSerializer jsonSerializer =>
jsonSerializer a
ser)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$
      Schema -> NamedSchema
unnamed (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$
        ( (IsLabel
  "_schemaType" (Optic' A_Lens NoIx Schema (Maybe OpenApiType))
Optic' A_Lens NoIx Schema (Maybe OpenApiType)
#_schemaType Optic' A_Lens NoIx Schema (Maybe OpenApiType)
-> OpenApiType -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject)
            (Schema -> Schema) -> (Schema -> Schema) -> Schema -> Schema
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IsLabel
  "_schemaAdditionalProperties"
  (Optic
     A_Lens
     NoIx
     Schema
     Schema
     (Maybe AdditionalProperties)
     (Maybe AdditionalProperties))
Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe AdditionalProperties)
  (Maybe AdditionalProperties)
#_schemaAdditionalProperties Optic
  A_Lens
  NoIx
  Schema
  Schema
  (Maybe AdditionalProperties)
  (Maybe AdditionalProperties)
-> AdditionalProperties -> Schema -> Schema
forall k (is :: IxList) s t a b.
Is k A_Setter =>
Optic k is s t a (Maybe b) -> b -> s -> t
?~ Referenced Schema -> AdditionalProperties
AdditionalPropertiesSchema Referenced Schema
r)
        )
          Schema
forall a. Monoid a => a
mempty
  serializeNull :: JSONSchema any
serializeNull =
    case JSONSchema ()
forall (f :: * -> *). JSONParser f => f ()
parseNull of
      JSONSchema Declare (Definitions Schema) NamedSchema
a -> Declare (Definitions Schema) NamedSchema -> JSONSchema any
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema Declare (Definitions Schema) NamedSchema
a
  serializeTextConstant :: Text -> JSONSchema a
serializeTextConstant Text
t = let (JSONSchema Declare (Definitions Schema) NamedSchema
a) = Text -> JSONSchema ()
forall (f :: * -> *). JSONParser f => Text -> f ()
parseTextConstant Text
t in Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema Declare (Definitions Schema) NamedSchema
a
  nameSerializer :: Text -> JSONSchema a -> JSONSchema a
nameSerializer Text
t = \JSONSchema a
ser -> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a. Declare (Definitions Schema) NamedSchema -> JSONSchema a
JSONSchema (Declare (Definitions Schema) NamedSchema -> JSONSchema a)
-> Declare (Definitions Schema) NamedSchema -> JSONSchema a
forall a b. (a -> b) -> a -> b
$ do
    (NamedSchema Maybe Text
_ Schema
s) <- JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema JSONSchema a
ser
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
encodeRefName Text
t) Schema
s

-- | Get documentation for a type that implements 'Jordan.FromJSON.Class.FromJSON', in the @ Declare @ environment.
--
-- This will be inline documention, IE, it will be named but not stored in the schema definitions.
getFromNamed :: forall a. (FromJSON a) => Proxy a -> Declare (Definitions Schema) NamedSchema
getFromNamed :: Proxy a -> Declare (Definitions Schema) NamedSchema
getFromNamed Proxy a
p = JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema (JSONSchema a
forall value (f :: * -> *).
(FromJSON value, JSONParser f) =>
f value
fromJSON :: JSONSchema a)

-- | Get documention for a type that implements 'Jordan.FromJSON.Class.FromJSON'.
--
-- This will store the type in the schemas key of the schema definitions, and give back a reference to it.
getFromRef :: forall a. (FromJSON a) => Proxy a -> Declare (Definitions Schema) (Referenced Schema)
getFromRef :: Proxy a -> Declare (Definitions Schema) (Referenced Schema)
getFromRef = Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> Proxy a
-> Declare (Definitions Schema) (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
FromJSON a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
getFromNamed

-- | Get documentation for a type that implements 'Jordan.ToJSON.Class.ToJSON'.
--
-- This will be inline documentation, IE, it will be named but not stored in the schema definitions.
getToNamed :: forall a. (ToJSON a) => Proxy a -> Declare (Definitions Schema) NamedSchema
getToNamed :: Proxy a -> Declare (Definitions Schema) NamedSchema
getToNamed Proxy a
p = JSONSchema a -> Declare (Definitions Schema) NamedSchema
forall a. JSONSchema a -> Declare (Definitions Schema) NamedSchema
getJSONSchema (JSONSchema a
forall v (f :: * -> *). (ToJSON v, JSONSerializer f) => f v
toJSON :: JSONSchema a)

-- | Get documentation for a type that implements 'Jordan.ToJSON.Class.ToJSON'.
--
-- This will store the type in the schemas key of the schemas definitions, then give back a reference to it.
getToRef :: forall a. (ToJSON a) => Proxy a -> Declare (Definitions Schema) (Referenced Schema)
getToRef :: Proxy a -> Declare (Definitions Schema) (Referenced Schema)
getToRef = Declare (Definitions Schema) NamedSchema
-> Declare (Definitions Schema) (Referenced Schema)
getRefDef (Declare (Definitions Schema) NamedSchema
 -> Declare (Definitions Schema) (Referenced Schema))
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> Proxy a
-> Declare (Definitions Schema) (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy a -> Declare (Definitions Schema) NamedSchema
forall a.
ToJSON a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
getToNamed