{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}

-- | Defines functionality for the generation of models from OpenAPI schemas
module OpenAPI.Generate.Model
  ( getSchemaType,
    resolveSchemaReferenceWithoutWarning,
    getConstraintDescriptionsOfSchema,
    defineModelForSchemaNamed,
    defineModelForSchema,
    TypeWithDeclaration,
  )
where

import Control.Applicative
import Control.Monad
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Text as Aeson
import qualified Data.Bifunctor as BF
import qualified Data.Either as E
import qualified Data.Int as Int
import qualified Data.List as List
import Data.List.NonEmpty (NonEmpty)
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Scientific as Scientific
import qualified Data.Set as Set
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Lazy as LT
import Data.Time.Calendar
import Language.Haskell.TH
import Language.Haskell.TH.PprLib hiding ((<>))
import qualified OpenAPI.Common as OC
import OpenAPI.Generate.Doc (appendDoc, emptyDoc)
import qualified OpenAPI.Generate.Doc as Doc
import OpenAPI.Generate.Internal.Util
import qualified OpenAPI.Generate.ModelDependencies as Dep
import qualified OpenAPI.Generate.Monad as OAM
import qualified OpenAPI.Generate.OptParse as OAO
import OpenAPI.Generate.OptParse.Types
import qualified OpenAPI.Generate.Types as OAT
import qualified OpenAPI.Generate.Types.Schema as OAS
import Prelude hiding (maximum, minimum, not)

-- | The type of a model and the declarations needed for defining it
type TypeWithDeclaration = (Q Type, Dep.ModelContentWithDependencies)

type BangTypesSelfDefined = (Q [VarBangType], Q Doc, Dep.Models)

data TypeAliasStrategy = CreateTypeAlias | DontCreateTypeAlias
  deriving (Int -> TypeAliasStrategy -> ShowS
[TypeAliasStrategy] -> ShowS
TypeAliasStrategy -> String
(Int -> TypeAliasStrategy -> ShowS)
-> (TypeAliasStrategy -> String)
-> ([TypeAliasStrategy] -> ShowS)
-> Show TypeAliasStrategy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeAliasStrategy -> ShowS
showsPrec :: Int -> TypeAliasStrategy -> ShowS
$cshow :: TypeAliasStrategy -> String
show :: TypeAliasStrategy -> String
$cshowList :: [TypeAliasStrategy] -> ShowS
showList :: [TypeAliasStrategy] -> ShowS
Show, TypeAliasStrategy -> TypeAliasStrategy -> Bool
(TypeAliasStrategy -> TypeAliasStrategy -> Bool)
-> (TypeAliasStrategy -> TypeAliasStrategy -> Bool)
-> Eq TypeAliasStrategy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
== :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
$c/= :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
/= :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
Eq, Eq TypeAliasStrategy
Eq TypeAliasStrategy =>
(TypeAliasStrategy -> TypeAliasStrategy -> Ordering)
-> (TypeAliasStrategy -> TypeAliasStrategy -> Bool)
-> (TypeAliasStrategy -> TypeAliasStrategy -> Bool)
-> (TypeAliasStrategy -> TypeAliasStrategy -> Bool)
-> (TypeAliasStrategy -> TypeAliasStrategy -> Bool)
-> (TypeAliasStrategy -> TypeAliasStrategy -> TypeAliasStrategy)
-> (TypeAliasStrategy -> TypeAliasStrategy -> TypeAliasStrategy)
-> Ord TypeAliasStrategy
TypeAliasStrategy -> TypeAliasStrategy -> Bool
TypeAliasStrategy -> TypeAliasStrategy -> Ordering
TypeAliasStrategy -> TypeAliasStrategy -> TypeAliasStrategy
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TypeAliasStrategy -> TypeAliasStrategy -> Ordering
compare :: TypeAliasStrategy -> TypeAliasStrategy -> Ordering
$c< :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
< :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
$c<= :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
<= :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
$c> :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
> :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
$c>= :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
>= :: TypeAliasStrategy -> TypeAliasStrategy -> Bool
$cmax :: TypeAliasStrategy -> TypeAliasStrategy -> TypeAliasStrategy
max :: TypeAliasStrategy -> TypeAliasStrategy -> TypeAliasStrategy
$cmin :: TypeAliasStrategy -> TypeAliasStrategy -> TypeAliasStrategy
min :: TypeAliasStrategy -> TypeAliasStrategy -> TypeAliasStrategy
Ord)

addDependencies :: Dep.Models -> OAM.Generator TypeWithDeclaration -> OAM.Generator TypeWithDeclaration
addDependencies :: Models
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
addDependencies Models
dependenciesToAdd Generator TypeWithDeclaration
typeDef = do
  (Q Type
type', (Q Doc
content, Models
dependencies)) <- Generator TypeWithDeclaration
typeDef
  TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q Type
type', (Q Doc
content, Models -> Models -> Models
forall a. Ord a => Set a -> Set a -> Set a
Set.union Models
dependencies Models
dependenciesToAdd))

-- | default derive clause for the objects
objectDeriveClause :: [Q DerivClause]
objectDeriveClause :: [Q DerivClause]
objectDeriveClause =
  [ Maybe DerivStrategy -> [Q Type] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Type] -> m DerivClause
derivClause
      Maybe DerivStrategy
forall a. Maybe a
Nothing
      [ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Show,
        Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Eq
      ]
  ]

liftAesonValueWithOverloadedStrings :: Bool -> Aeson.Value -> Q Exp
liftAesonValueWithOverloadedStrings :: Bool -> Value -> Q Exp
liftAesonValueWithOverloadedStrings Bool
useOverloadedStrings (Aeson.String Text
a) =
  let s :: Q Exp
s = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
a
   in if Bool
useOverloadedStrings
        then [|$Q Exp
s|]
        else [|Aeson.String $Q Exp
s|]
liftAesonValueWithOverloadedStrings Bool
_ (Aeson.Number Scientific
n) =
  -- Without the manual handling of numbers, TH tries to use
  -- `Scientific.Scientific` which is not exposed.
  let coefficient :: Integer
coefficient = Scientific -> Integer
Scientific.coefficient Scientific
n
      base10Exponent :: Int
base10Exponent = Scientific -> Int
Scientific.base10Exponent Scientific
n
   in [|Aeson.Number (Scientific.scientific coefficient base10Exponent)|]
liftAesonValueWithOverloadedStrings Bool
_ Value
a = [|a|]

liftAesonValue :: Aeson.Value -> Q Exp
liftAesonValue :: Value -> Q Exp
liftAesonValue = Bool -> Value -> Q Exp
liftAesonValueWithOverloadedStrings Bool
True

aesonValueToName :: Aeson.Value -> Text
aesonValueToName :: Value -> Text
aesonValueToName =
  ( \case
      Text
"" -> Text
"EmptyString"
      Text
x -> Text
x
  )
    (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
uppercaseFirstText
    (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"\"" Text
""
    (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
showAesonValue

showAesonValue :: Aeson.Value -> Text
showAesonValue :: Value -> Text
showAesonValue = Text -> Text
LT.toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
forall a. ToJSON a => a -> Text
Aeson.encodeToLazyText

-- | Defines all the models for a schema
defineModelForSchema :: Text -> OAS.Schema -> OAM.Generator Dep.ModelWithDependencies
defineModelForSchema :: Text -> Schema -> Generator ModelWithDependencies
defineModelForSchema Text
schemaName Schema
schema = do
  let aliasWithText :: Text -> Generator TypeWithDeclaration
aliasWithText Text
description =
        Text
-> Text
-> TypeAliasStrategy
-> Generator TypeWithDeclaration
-> Generator TypeWithDeclaration
createAlias Text
schemaName Text
description TypeAliasStrategy
CreateTypeAlias (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$
          TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([t|Aeson.Value|], (Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Models
forall a. Set a
Set.empty))
      blackListAlias :: Generator TypeWithDeclaration
blackListAlias = Text -> Generator TypeWithDeclaration
aliasWithText Text
"This alias is created because of the generator configuration and possibly could have a more precise type."
      whiteListAlias :: Generator TypeWithDeclaration
whiteListAlias = Text -> Generator TypeWithDeclaration
aliasWithText (Text -> Generator TypeWithDeclaration)
-> Text -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Text
"This is just a type synonym and possibly could have a more precise type because the schema name @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@ is not whitelisted."
  [Text]
settingOpaqueSchemas <- (Settings -> [Text]) -> Generator [Text]
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> [Text]
OAO.settingOpaqueSchemas
  [Text]
whiteListedSchemas <- (Settings -> [Text]) -> Generator [Text]
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> [Text]
OAO.settingWhiteListedSchemas
  TypeWithDeclaration
namedSchema <-
    Text
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. Text -> Generator a -> Generator a
OAM.nested Text
schemaName (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$
      if Text
schemaName Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
settingOpaqueSchemas
        then Generator TypeWithDeclaration
blackListAlias
        else if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
whiteListedSchemas Bool -> Bool -> Bool
|| Text
schemaName Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Text]
whiteListedSchemas then TypeAliasStrategy
-> Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamedWithTypeAliasStrategy TypeAliasStrategy
CreateTypeAlias Text
schemaName Schema
schema else Generator TypeWithDeclaration
whiteListAlias
  ModelWithDependencies -> Generator ModelWithDependencies
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Text
transformToModuleName Text
schemaName, TypeWithDeclaration -> (Q Doc, Models)
forall a b. (a, b) -> b
snd TypeWithDeclaration
namedSchema)

-- | Defines all the models for a schema and returns the declarations with the type of the root model
defineModelForSchemaNamed :: Text -> OAS.Schema -> OAM.Generator TypeWithDeclaration
defineModelForSchemaNamed :: Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamed = TypeAliasStrategy
-> Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamedWithTypeAliasStrategy TypeAliasStrategy
DontCreateTypeAlias

-- | defines the definitions for a schema and returns a type to the "entrypoint" of the schema
defineModelForSchemaNamedWithTypeAliasStrategy :: TypeAliasStrategy -> Text -> OAS.Schema -> OAM.Generator TypeWithDeclaration
defineModelForSchemaNamedWithTypeAliasStrategy :: TypeAliasStrategy
-> Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamedWithTypeAliasStrategy TypeAliasStrategy
strategy Text
schemaName Schema
schema =
  case Schema
schema of
    OAT.Concrete SchemaObject
concrete -> TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineModelForSchemaConcrete TypeAliasStrategy
strategy Text
schemaName SchemaObject
concrete
    OAT.Reference Text
reference -> do
      Name
refName <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True (Text -> Generator Name) -> Text -> Generator Name
forall a b. (a -> b) -> a -> b
$ Text -> Text
getSchemaNameFromReference Text
reference
      Text -> Generator ()
OAM.logTrace (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Encountered reference '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
reference Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' which references the type '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Name -> String
nameBase Name
refName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
      Text
-> Text
-> TypeAliasStrategy
-> Generator TypeWithDeclaration
-> Generator TypeWithDeclaration
createAlias Text
schemaName Text
"" TypeAliasStrategy
strategy (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$
        TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
refName, (Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Text -> Models
transformReferenceToDependency Text
reference))

getSchemaNameFromReference :: Text -> Text
getSchemaNameFromReference :: Text -> Text
getSchemaNameFromReference = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
T.replace Text
"#/components/schemas/" Text
""

transformReferenceToDependency :: Text -> Set.Set Text
transformReferenceToDependency :: Text -> Models
transformReferenceToDependency = Text -> Models
forall a. a -> Set a
Set.singleton (Text -> Models) -> (Text -> Text) -> Text -> Models
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
transformToModuleName (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
getSchemaNameFromReference

-- | Transforms a 'OAS.Schema' (either a reference or a concrete object) to @'Maybe' 'OAS.SchemaObject'@
-- If a reference is found it is resolved. If it is not found, no log message is generated.
resolveSchemaReferenceWithoutWarning :: OAS.Schema -> OAM.Generator (Maybe OAS.SchemaObject)
resolveSchemaReferenceWithoutWarning :: Schema -> Generator (Maybe SchemaObject)
resolveSchemaReferenceWithoutWarning Schema
schema =
  case Schema
schema of
    OAT.Concrete SchemaObject
concrete -> Maybe SchemaObject -> Generator (Maybe SchemaObject)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe SchemaObject -> Generator (Maybe SchemaObject))
-> Maybe SchemaObject -> Generator (Maybe SchemaObject)
forall a b. (a -> b) -> a -> b
$ SchemaObject -> Maybe SchemaObject
forall a. a -> Maybe a
Just SchemaObject
concrete
    OAT.Reference Text
ref -> Text -> Generator (Maybe SchemaObject)
OAM.getSchemaReferenceM Text
ref

resolveSchemaReference :: Text -> OAS.Schema -> OAM.Generator (Maybe (OAS.SchemaObject, Dep.Models))
resolveSchemaReference :: Text -> Schema -> Generator (Maybe (SchemaObject, Models))
resolveSchemaReference Text
schemaName Schema
schema =
  case Schema
schema of
    OAT.Concrete SchemaObject
concrete -> Maybe (SchemaObject, Models)
-> Generator (Maybe (SchemaObject, Models))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SchemaObject, Models)
 -> Generator (Maybe (SchemaObject, Models)))
-> Maybe (SchemaObject, Models)
-> Generator (Maybe (SchemaObject, Models))
forall a b. (a -> b) -> a -> b
$ (SchemaObject, Models) -> Maybe (SchemaObject, Models)
forall a. a -> Maybe a
Just (SchemaObject
concrete, Models
forall a. Set a
Set.empty)
    OAT.Reference Text
ref -> do
      Maybe SchemaObject
p <- Text -> Generator (Maybe SchemaObject)
OAM.getSchemaReferenceM Text
ref
      Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe SchemaObject -> Bool
forall a. Maybe a -> Bool
Maybe.isNothing Maybe SchemaObject
p) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$
        Text -> Generator ()
OAM.logWarning (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$
          Text
"Reference '"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ref
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' to schema from '"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
schemaName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' could not be found and therefore will be skipped."
      Maybe (SchemaObject, Models)
-> Generator (Maybe (SchemaObject, Models))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SchemaObject, Models)
 -> Generator (Maybe (SchemaObject, Models)))
-> Maybe (SchemaObject, Models)
-> Generator (Maybe (SchemaObject, Models))
forall a b. (a -> b) -> a -> b
$ (,Text -> Models
transformReferenceToDependency Text
ref) (SchemaObject -> (SchemaObject, Models))
-> Maybe SchemaObject -> Maybe (SchemaObject, Models)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SchemaObject
p

-- | creates an alias depending on the strategy
createAlias :: Text -> Text -> TypeAliasStrategy -> OAM.Generator TypeWithDeclaration -> OAM.Generator TypeWithDeclaration
createAlias :: Text
-> Text
-> TypeAliasStrategy
-> Generator TypeWithDeclaration
-> Generator TypeWithDeclaration
createAlias Text
schemaName Text
description TypeAliasStrategy
strategy Generator TypeWithDeclaration
res = do
  Name
schemaName' <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True Text
schemaName
  (Q Type
type', (Q Doc
content, Models
dependencies)) <- Generator TypeWithDeclaration
res
  Text
path <- Generator Text
getCurrentPathEscaped
  TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeWithDeclaration -> Generator TypeWithDeclaration)
-> TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ case TypeAliasStrategy
strategy of
    TypeAliasStrategy
CreateTypeAlias ->
      ( Q Type
type',
        ( Q Doc
content
            Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` ( ( [Text] -> Doc
Doc.generateHaddockComment
                              [ Text
"Defines an alias for the schema located at @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@ in the specification.",
                                Text
"",
                                Text
description
                              ]
                              Doc -> Doc -> Doc
$$
                          )
                            (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
                            (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> [TyVarBndr ()] -> Q Type -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr ()] -> m Type -> m Dec
tySynD Name
schemaName' [] Q Type
type'
                        ),
          Models
dependencies
        )
      )
    TypeAliasStrategy
DontCreateTypeAlias -> (Q Type
type', (Q Doc
content, Models
dependencies))

-- | returns the type of a schema. Second return value is a 'Q' Monad, for the types that have to be created
defineModelForSchemaConcrete :: TypeAliasStrategy -> Text -> OAS.SchemaObject -> OAM.Generator TypeWithDeclaration
defineModelForSchemaConcrete :: TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineModelForSchemaConcrete TypeAliasStrategy
strategy Text
schemaName SchemaObject
schema = do
  Text
nonNullableTypeSuffix <- (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingNonNullableTypeSuffix
  let enumValues :: [Value]
enumValues = SchemaObject -> [Value]
OAS.schemaObjectEnum SchemaObject
schema
      schemaNameWithNonNullableSuffix :: Text
schemaNameWithNonNullableSuffix = if SchemaObject -> Bool
OAS.schemaObjectNullable SchemaObject
schema then Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nonNullableTypeSuffix else Text
schemaName
  TypeWithDeclaration
typeWithDeclaration <-
    if [Value] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
enumValues
      then TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineModelForSchemaConcreteIgnoreEnum TypeAliasStrategy
strategy Text
schemaNameWithNonNullableSuffix SchemaObject
schema
      else Text -> SchemaObject -> [Value] -> Generator TypeWithDeclaration
defineEnumModel Text
schemaNameWithNonNullableSuffix SchemaObject
schema [Value]
enumValues
  if SchemaObject -> Bool
OAS.schemaObjectNullable SchemaObject
schema
    then TypeAliasStrategy
-> Text -> TypeWithDeclaration -> Generator TypeWithDeclaration
defineNullableTypeAlias TypeAliasStrategy
strategy Text
schemaName TypeWithDeclaration
typeWithDeclaration
    else TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeWithDeclaration
typeWithDeclaration

defineNullableTypeAlias :: TypeAliasStrategy -> Text -> TypeWithDeclaration -> OAM.Generator TypeWithDeclaration
defineNullableTypeAlias :: TypeAliasStrategy
-> Text -> TypeWithDeclaration -> Generator TypeWithDeclaration
defineNullableTypeAlias TypeAliasStrategy
strategy Text
schemaName (Q Type
type', (Q Doc
content, Models
dependencies)) = do
  Text
nonNullableTypeSuffix <- (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingNonNullableTypeSuffix
  let nullableType :: Q Type
nullableType = Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT ''OC.Nullable) Q Type
type'
  case TypeAliasStrategy
strategy of
    TypeAliasStrategy
CreateTypeAlias -> do
      Text
path <- Generator Text
getCurrentPathEscaped
      Name
name <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True Text
schemaName
      TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name,
          ( Q Doc
content
              Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` ( ( [Text] -> Doc
Doc.generateHaddockComment
                                [ Text
"Defines a nullable type alias for '"
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
schemaName
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nonNullableTypeSuffix
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' as the schema located at @"
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path
                                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@ in the specification is marked as nullable."
                                ]
                                Doc -> Doc -> Doc
$$
                            )
                              (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
                              (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> [TyVarBndr ()] -> Q Type -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr ()] -> m Type -> m Dec
tySynD Name
name [] Q Type
nullableType
                          ),
            Models
dependencies
          )
        )
    TypeAliasStrategy
DontCreateTypeAlias -> TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q Type
nullableType, (Q Doc
content, Models
dependencies))

-- | Creates a Model, ignores enum values
defineModelForSchemaConcreteIgnoreEnum :: TypeAliasStrategy -> Text -> OAS.SchemaObject -> OAM.Generator TypeWithDeclaration
defineModelForSchemaConcreteIgnoreEnum :: TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineModelForSchemaConcreteIgnoreEnum TypeAliasStrategy
strategy Text
schemaName SchemaObject
schema = do
  Settings
settings <- Generator Settings
OAM.getSettings
  let schemaDescription :: Text
schemaDescription = SchemaObject -> Text
getDescriptionOfSchema SchemaObject
schema
      typeAliasing :: Generator TypeWithDeclaration -> Generator TypeWithDeclaration
typeAliasing = Text
-> Text
-> TypeAliasStrategy
-> Generator TypeWithDeclaration
-> Generator TypeWithDeclaration
createAlias Text
schemaName Text
schemaDescription TypeAliasStrategy
strategy
  case SchemaObject
schema of
    OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeArray} -> TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineArrayModelForSchema TypeAliasStrategy
strategy Text
schemaName SchemaObject
schema
    OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeObject} ->
      let allOfNull :: Bool
allOfNull = [Schema] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Schema] -> Bool) -> [Schema] -> Bool
forall a b. (a -> b) -> a -> b
$ SchemaObject -> [Schema]
OAS.schemaObjectAllOf SchemaObject
schema
          oneOfNull :: Bool
oneOfNull = [Schema] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Schema] -> Bool) -> [Schema] -> Bool
forall a b. (a -> b) -> a -> b
$ SchemaObject -> [Schema]
OAS.schemaObjectOneOf SchemaObject
schema
          anyOfNull :: Bool
anyOfNull = [Schema] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Schema] -> Bool) -> [Schema] -> Bool
forall a b. (a -> b) -> a -> b
$ SchemaObject -> [Schema]
OAS.schemaObjectAnyOf SchemaObject
schema
       in case (Bool
allOfNull, Bool
oneOfNull, Bool
anyOfNull) of
            (Bool
False, Bool
_, Bool
_) -> Text
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"allOf" (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineAllOfSchema Text
schemaName Text
schemaDescription ([Schema] -> Generator TypeWithDeclaration)
-> [Schema] -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ SchemaObject -> [Schema]
OAS.schemaObjectAllOf SchemaObject
schema
            (Bool
_, Bool
False, Bool
_) -> Text
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"oneOf" (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Generator TypeWithDeclaration -> Generator TypeWithDeclaration
typeAliasing (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineOneOfSchema Text
schemaName Text
schemaDescription ([Schema] -> Generator TypeWithDeclaration)
-> [Schema] -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ SchemaObject -> [Schema]
OAS.schemaObjectOneOf SchemaObject
schema
            (Bool
_, Bool
_, Bool
False) -> Text
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"anyOf" (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ TypeAliasStrategy
-> Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineAnyOfSchema TypeAliasStrategy
strategy Text
schemaName Text
schemaDescription ([Schema] -> Generator TypeWithDeclaration)
-> [Schema] -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ SchemaObject -> [Schema]
OAS.schemaObjectAnyOf SchemaObject
schema
            (Bool, Bool, Bool)
_ -> TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineObjectModelForSchema TypeAliasStrategy
strategy Text
schemaName SchemaObject
schema
    SchemaObject
_ ->
      Generator TypeWithDeclaration -> Generator TypeWithDeclaration
typeAliasing (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT (Name -> Q Type) -> Name -> Q Type
forall a b. (a -> b) -> a -> b
$ Settings -> SchemaObject -> Name
getSchemaType Settings
settings SchemaObject
schema, (Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Models
forall a. Set a
Set.empty))

defineEnumModel :: Text -> OAS.SchemaObject -> [Aeson.Value] -> OAM.Generator TypeWithDeclaration
defineEnumModel :: Text -> SchemaObject -> [Value] -> Generator TypeWithDeclaration
defineEnumModel Text
schemaName SchemaObject
schema [Value]
enumValues = do
  Name
name <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True Text
schemaName
  Text -> Generator ()
OAM.logInfo (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Define as enum named '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Name -> String
nameBase Name
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
  let getConstructor :: (a, b, c) -> a
getConstructor (a
a, b
_, c
_) = a
a
      getValueInfo :: Value -> Generator (m Con, Name, Value)
getValueInfo Value
value = do
        Name
cname <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
"Enum" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
aesonValueToName Value
value)
        (m Con, Name, Value) -> Generator (m Con, Name, Value)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> [m BangType] -> m Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
cname [], Name
cname, Value
value)
  (Q Type
typ, (Q Doc
_, Models
dependencies)) <- TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineModelForSchemaConcreteIgnoreEnum TypeAliasStrategy
DontCreateTypeAlias (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"EnumValue") SchemaObject
schema
  [(Q Con, Name, Value)]
constructorsInfo <- (Value -> Generator (Q Con, Name, Value))
-> [Value] -> Generator [(Q Con, Name, Value)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Value -> Generator (Q Con, Name, Value)
forall {m :: * -> *}.
Quote m =>
Value -> Generator (m Con, Name, Value)
getValueInfo [Value]
enumValues
  Name
fallbackName <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True (Text -> Generator Name) -> Text -> Generator Name
forall a b. (a -> b) -> a -> b
$ Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Other"
  Name
typedName <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True (Text -> Generator Name) -> Text -> Generator Name
forall a b. (a -> b) -> a -> b
$ Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Typed"
  Text
path <- Generator Text
getCurrentPathEscaped
  let nameValuePairs :: [(Name, Value)]
nameValuePairs = ((Q Con, Name, Value) -> (Name, Value))
-> [(Q Con, Name, Value)] -> [(Name, Value)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Q Con
_, Name
a, Value
b) -> (Name
a, Value
b)) [(Q Con, Name, Value)]
constructorsInfo
      toBangType :: m b -> m (Bang, b)
toBangType m b
t = do
        Bang
ban <- m SourceUnpackedness -> m SourceStrictness -> m Bang
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Bang
bang m SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness m SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness
        b
banT <- m b
t
        (Bang, b) -> m (Bang, b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bang
ban, b
banT)
      fallbackC :: Q Con
fallbackC = Name -> [Q BangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
fallbackName [Q Type -> Q BangType
forall {m :: * -> *} {b}. Quote m => m b -> m (Bang, b)
toBangType (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT ''Aeson.Value)]
      typedC :: Q Con
typedC = Name -> [Q BangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
typedName [Q Type -> Q BangType
forall {m :: * -> *} {b}. Quote m => m b -> m (Bang, b)
toBangType Q Type
typ]
      jsonImplementation :: Q Doc
jsonImplementation = Name -> Name -> Name -> [(Name, Value)] -> Q Doc
defineJsonImplementationForEnum Name
name Name
fallbackName Name
typedName [(Name, Value)]
nameValuePairs
      comments :: [Text]
comments = (Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text
"Represents the JSON value @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@") (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
showAesonValue) [Value]
enumValues
      newType :: Q Doc
newType =
        ( [Text] -> Doc
Doc.generateHaddockComment
            [ Text
"Defines the enum schema located at @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@ in the specification.",
              Text
"",
              SchemaObject -> Text
getDescriptionOfSchema SchemaObject
schema
            ]
            Doc -> Doc -> Doc
$$
        )
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( Doc -> Doc -> Doc
`Doc.sideBySide`
                ( String -> Doc
text String
""
                    Doc -> Doc -> Doc
$$ [Text] -> Doc
Doc.sideComments
                      ( Text
"This case is used if the value encountered during decoding does not match any of the provided cases in the specification."
                          Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"This constructor can be used to send values to the server which are not present in the specification yet."
                          Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
comments
                      )
                )
            )
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
Doc.reformatADT
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
          (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD
            (Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
            Name
name
            []
            Maybe Type
forall a. Maybe a
Nothing
            (Q Con
fallbackC Q Con -> [Q Con] -> [Q Con]
forall a. a -> [a] -> [a]
: Q Con
typedC Q Con -> [Q Con] -> [Q Con]
forall a. a -> [a] -> [a]
: ((Q Con, Name, Value) -> Q Con
forall {a} {b} {c}. (a, b, c) -> a
getConstructor ((Q Con, Name, Value) -> Q Con)
-> [(Q Con, Name, Value)] -> [Q Con]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Q Con, Name, Value)]
constructorsInfo))
            [Q DerivClause]
objectDeriveClause
  TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name, (Q Doc
newType Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
jsonImplementation, Models
dependencies))

defineJsonImplementationForEnum :: Name -> Name -> Name -> [(Name, Aeson.Value)] -> Q Doc
defineJsonImplementationForEnum :: Name -> Name -> Name -> [(Name, Value)] -> Q Doc
defineJsonImplementationForEnum Name
name Name
fallbackName Name
typedName [(Name, Value)]
nameValues =
  -- without this function, a N long string takes up N lines, as every
  -- new character starts on a new line
  let (Q Exp
e, Q Pat
p) = (\Name
n -> (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
n, Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
n)) (Name -> (Q Exp, Q Pat)) -> Name -> (Q Exp, Q Pat)
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
"val"
      fromJsonCases :: Q Exp
fromJsonCases =
        [Q (Guard, Exp)] -> Q Exp
forall (m :: * -> *). Quote m => [m (Guard, Exp)] -> m Exp
multiIfE ([Q (Guard, Exp)] -> Q Exp) -> [Q (Guard, Exp)] -> Q Exp
forall a b. (a -> b) -> a -> b
$
          ((Name, Value) -> Q (Guard, Exp))
-> [(Name, Value)] -> [Q (Guard, Exp)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
            ( \(Name
name', Value
value) -> Q Exp -> Q Exp -> Q (Guard, Exp)
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m (Guard, Exp)
normalGE [|$Q Exp
e == $(Value -> Q Exp
liftAesonValue Value
value)|] (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
name')
            )
            [(Name, Value)]
nameValues
            [Q (Guard, Exp)] -> [Q (Guard, Exp)] -> [Q (Guard, Exp)]
forall a. Semigroup a => a -> a -> a
<> [Q Exp -> Q Exp -> Q (Guard, Exp)
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m (Guard, Exp)
normalGE [|otherwise|] [|$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
fallbackName) $Q Exp
e|]]
      fromJsonFn :: Q Dec
fromJsonFn =
        Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
          (String -> Name
mkName String
"parseJSON")
          [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Q Pat
p] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|pure $Q Exp
fromJsonCases|]) []]
      fromJson :: Q Dec
fromJson = Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt []) [t|Aeson.FromJSON $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name)|] [Q Dec
fromJsonFn]
      toJsonFnClause :: Name -> [m Pat] -> m Exp -> m Dec
toJsonFnClause Name
n [m Pat]
ps m Exp
ex =
        Name -> [m Clause] -> m Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
          (String -> Name
mkName String
"toJSON")
          [ [m Pat] -> m Body -> [m Dec] -> m Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
              [Name -> [m Pat] -> m Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
n [m Pat]
ps]
              (m Exp -> m Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB m Exp
ex)
              []
          ]
      toJsonClause :: (Name, a) -> Q Dec
toJsonClause (Name
name', a
value) = Name -> [Q Pat] -> Q Exp -> Q Dec
forall {m :: * -> *}. Quote m => Name -> [m Pat] -> m Exp -> m Dec
toJsonFnClause Name
name' [] (Q Exp -> Q Dec) -> Q Exp -> Q Dec
forall a b. (a -> b) -> a -> b
$ Value -> Q Exp
liftAesonValue (Value -> Q Exp) -> Value -> Q Exp
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
value
      toJsonFns :: [Q Dec]
toJsonFns =
        Name -> [Q Pat] -> Q Exp -> Q Dec
forall {m :: * -> *}. Quote m => Name -> [m Pat] -> m Exp -> m Dec
toJsonFnClause Name
fallbackName [Q Pat
p] Q Exp
e
          Q Dec -> [Q Dec] -> [Q Dec]
forall a. a -> [a] -> [a]
: Name -> [Q Pat] -> Q Exp -> Q Dec
forall {m :: * -> *}. Quote m => Name -> [m Pat] -> m Exp -> m Dec
toJsonFnClause Name
typedName [Q Pat
p] [|Aeson.toJSON $Q Exp
e|]
          Q Dec -> [Q Dec] -> [Q Dec]
forall a. a -> [a] -> [a]
: ((Name, Value) -> Q Dec
forall {a}. ToJSON a => (Name, a) -> Q Dec
toJsonClause ((Name, Value) -> Q Dec) -> [(Name, Value)] -> [Q Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Name, Value)]
nameValues)
      toJson :: Q Dec
toJson = Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt []) [t|Aeson.ToJSON $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name)|] [Q Dec]
toJsonFns
   in (Dec -> Doc) -> Q Dec -> Q Doc
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dec -> Doc
forall a. Ppr a => a -> Doc
ppr Q Dec
toJson Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` (Dec -> Doc) -> Q Dec -> Q Doc
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dec -> Doc
forall a. Ppr a => a -> Doc
ppr Q Dec
fromJson

-- | defines anyOf types
--
-- If the subschemas consist only of objects an allOf type without any required field can be generated
-- If there are differen subschema types, per schematype a oneOf is generated
defineAnyOfSchema :: TypeAliasStrategy -> Text -> Text -> [OAS.Schema] -> OAM.Generator TypeWithDeclaration
defineAnyOfSchema :: TypeAliasStrategy
-> Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineAnyOfSchema TypeAliasStrategy
strategy Text
schemaName Text
description [Schema]
schemas = do
  [(SchemaObject, Models)]
schemasWithDependencies <- (Schema -> Generator (Maybe (SchemaObject, Models)))
-> [Schema] -> Generator [(SchemaObject, Models)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (Text -> Schema -> Generator (Maybe (SchemaObject, Models))
resolveSchemaReference Text
schemaName) [Schema]
schemas
  let concreteSchemas :: [SchemaObject]
concreteSchemas = ((SchemaObject, Models) -> SchemaObject)
-> [(SchemaObject, Models)] -> [SchemaObject]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SchemaObject, Models) -> SchemaObject
forall a b. (a, b) -> a
fst [(SchemaObject, Models)]
schemasWithDependencies
      schemasWithoutRequired :: [SchemaObject]
schemasWithoutRequired = (SchemaObject -> SchemaObject) -> [SchemaObject] -> [SchemaObject]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\SchemaObject
o -> SchemaObject
o {OAS.schemaObjectRequired = Set.empty}) [SchemaObject]
concreteSchemas
      notObjectSchemas :: [SchemaObject]
notObjectSchemas = (SchemaObject -> Bool) -> [SchemaObject] -> [SchemaObject]
forall a. (a -> Bool) -> [a] -> [a]
filter (\SchemaObject
o -> SchemaObject -> SchemaType
OAS.schemaObjectType SchemaObject
o SchemaType -> SchemaType -> Bool
forall a. Eq a => a -> a -> Bool
/= SchemaType
OAS.SchemaTypeObject) [SchemaObject]
concreteSchemas
      newDependencies :: Models
newDependencies = [Models] -> Models
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Models] -> Models) -> [Models] -> Models
forall a b. (a -> b) -> a -> b
$ ((SchemaObject, Models) -> Models)
-> [(SchemaObject, Models)] -> [Models]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SchemaObject, Models) -> Models
forall a b. (a, b) -> b
snd [(SchemaObject, Models)]
schemasWithDependencies
  if [SchemaObject] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SchemaObject]
notObjectSchemas
    then do
      Text -> Generator ()
OAM.logTrace Text
"anyOf does not contain any schemas which are not of type object and will therefore be defined as allOf"
      Models
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
addDependencies Models
newDependencies (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineAllOfSchema Text
schemaName Text
description ((SchemaObject -> Schema) -> [SchemaObject] -> [Schema]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SchemaObject -> Schema
forall a. a -> Referencable a
OAT.Concrete [SchemaObject]
schemasWithoutRequired)
    else do
      Text -> Generator ()
OAM.logTrace Text
"anyOf does contain at least one schema which is not of type object and will therefore be defined as oneOf"
      Text
-> Text
-> TypeAliasStrategy
-> Generator TypeWithDeclaration
-> Generator TypeWithDeclaration
createAlias Text
schemaName Text
description TypeAliasStrategy
strategy (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineOneOfSchema Text
schemaName Text
description [Schema]
schemas

--    this would be the correct implementation
--    but it generates endless loop because some implementations use anyOf as a oneOf
--    where the schema reference itself
--      let objectSchemas = filter (\o -> OAS.schemaObjectType o == OAS.SchemaTypeObject) concreteSchemas
--      (propertiesCombined, _) <- fuseSchemasAllOf schemaName (fmap OAT.Concrete objectSchemas)
--      if null propertiesCombined then
--        createAlias schemaName strategy $ defineOneOfSchema schemaName schemas
--        else
--          let schemaPrototype = head objectSchemas
--              newSchema = schemaPrototype {OAS.schemaObjectProperties = propertiesCombined, OAS.schemaObjectRequired = Set.empty}
--          in
--            createAlias schemaName strategy $ defineOneOfSchema schemaName (fmap OAT.Concrete (newSchema : notObjectSchemas))

-- | defines a OneOf Schema
--
-- creates types for all the subschemas and then creates an adt with constructors for the different
-- subschemas. Constructors are numbered
defineOneOfSchema :: Text -> Text -> [OAS.Schema] -> OAM.Generator TypeWithDeclaration
defineOneOfSchema :: Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineOneOfSchema Text
schemaName Text
description [Schema]
allSchemas = do
  Bool -> Generator () -> Generator ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Schema] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Schema]
allSchemas) (Generator () -> Generator ()) -> Generator () -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text -> Generator ()
OAM.logWarning Text
"oneOf does not contain any sub-schemas and will therefore be defined as a void type"
  Settings
settings <- Generator Settings
OAM.getSettings
  let haskellifyConstructor :: Text -> Name
haskellifyConstructor = Bool -> Bool -> Text -> Name
haskellifyName (Settings -> Bool
OAO.settingConvertToCamelCase Settings
settings) Bool
True
      name :: Name
name = Text -> Name
haskellifyConstructor (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Variants"
      fixedValueStrategy :: FixedValueStrategy
fixedValueStrategy = Settings -> FixedValueStrategy
OAO.settingFixedValueStrategy Settings
settings
      ([Schema]
otherSchemas, [Value]
fixedValueSchemas, [(Text, Schema)]
singleFieldedSchemas) =
        let ([Schema]
s', [Value]
fixedValue) = FixedValueStrategy -> [Schema] -> ([Schema], [Value])
extractSchemasWithFixedValues FixedValueStrategy
fixedValueStrategy [Schema]
allSchemas
            ([Schema]
s'', [(Text, Schema)]
singleFielded) = [Schema] -> ([Schema], [(Text, Schema)])
extractSchemasWithSingleField [Schema]
s'
         in ([Schema]
s'', [Value]
fixedValue, [(Text, Schema)]
singleFielded)
      defineSingleFielded :: Text -> Schema -> Generator TypeWithDeclaration
defineSingleFielded Text
field = Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamed (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Bool -> Bool -> Text -> Text
haskellifyText (Settings -> Bool
OAO.settingConvertToCamelCase Settings
settings) Bool
True Text
field)
      indexedSchemas :: [(Schema, Integer)]
indexedSchemas = [Schema] -> [Integer] -> [(Schema, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Schema]
otherSchemas ([Integer
1 ..] :: [Integer])
      defineIndexed :: Schema -> a -> Generator TypeWithDeclaration
defineIndexed Schema
schema a
index = Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamed (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"OneOf" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
index)) Schema
schema
  Text -> Generator ()
OAM.logInfo (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Define as oneOf named '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Name -> String
nameBase Name
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
  [TypeWithDeclaration]
singleFieldedVariants <- ((Text, Schema) -> Generator TypeWithDeclaration)
-> [(Text, Schema)] -> Generator [TypeWithDeclaration]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Text -> Schema -> Generator TypeWithDeclaration)
-> (Text, Schema) -> Generator TypeWithDeclaration
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Schema -> Generator TypeWithDeclaration
defineSingleFielded) [(Text, Schema)]
singleFieldedSchemas
  [TypeWithDeclaration]
indexedVariants <- ((Schema, Integer) -> Generator TypeWithDeclaration)
-> [(Schema, Integer)] -> Generator [TypeWithDeclaration]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Schema -> Integer -> Generator TypeWithDeclaration)
-> (Schema, Integer) -> Generator TypeWithDeclaration
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Schema -> Integer -> Generator TypeWithDeclaration
forall {a}. Show a => Schema -> a -> Generator TypeWithDeclaration
defineIndexed) [(Schema, Integer)]
indexedSchemas
  Text
path <- Generator Text
getCurrentPathEscaped
  let variants :: [TypeWithDeclaration]
variants = [TypeWithDeclaration]
indexedVariants [TypeWithDeclaration]
-> [TypeWithDeclaration] -> [TypeWithDeclaration]
forall a. Semigroup a => a -> a -> a
<> [TypeWithDeclaration]
singleFieldedVariants
      variantDefinitions :: Q Doc
variantDefinitions = [Doc] -> Doc
vcat ([Doc] -> Doc) -> Q [Doc] -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (TypeWithDeclaration -> Q Doc) -> [TypeWithDeclaration] -> Q [Doc]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM ((Q Doc, Models) -> Q Doc
forall a b. (a, b) -> a
fst ((Q Doc, Models) -> Q Doc)
-> (TypeWithDeclaration -> (Q Doc, Models))
-> TypeWithDeclaration
-> Q Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeWithDeclaration -> (Q Doc, Models)
forall a b. (a, b) -> b
snd) [TypeWithDeclaration]
variants
      dependencies :: Models
dependencies = [Models] -> Models
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Models] -> Models) -> [Models] -> Models
forall a b. (a -> b) -> a -> b
$ (TypeWithDeclaration -> Models)
-> [TypeWithDeclaration] -> [Models]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Q Doc, Models) -> Models
forall a b. (a, b) -> b
snd ((Q Doc, Models) -> Models)
-> (TypeWithDeclaration -> (Q Doc, Models))
-> TypeWithDeclaration
-> Models
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeWithDeclaration -> (Q Doc, Models)
forall a b. (a, b) -> b
snd) [TypeWithDeclaration]
variants
      types :: [Q Type]
types = (TypeWithDeclaration -> Q Type)
-> [TypeWithDeclaration] -> [Q Type]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeWithDeclaration -> Q Type
forall a b. (a, b) -> a
fst [TypeWithDeclaration]
variants
      indexedTypes :: [(Q Type, Integer)]
indexedTypes = [Q Type] -> [Integer] -> [(Q Type, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Q Type]
types ([Integer
1 ..] :: [Integer])
      getConstructorName :: (m Type, b) -> m Name
getConstructorName (m Type
typ, b
n) = do
        Type
t <- m Type
typ
        let suffix :: Text
suffix = if Settings -> Bool
OAO.settingUseNumberedVariantConstructors Settings
settings then Text
"Variant" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (b -> String
forall a. Show a => a -> String
show b
n) else Type -> Text
typeToSuffix Type
t
        Name -> m Name
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Name -> m Name) -> Name -> m Name
forall a b. (a -> b) -> a -> b
$ Text -> Name
haskellifyConstructor (Text -> Name) -> Text -> Name
forall a b. (a -> b) -> a -> b
$ Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
suffix
      constructorNames :: [Q Name]
constructorNames = ((Q Type, Integer) -> Q Name) -> [(Q Type, Integer)] -> [Q Name]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Q Type, Integer) -> Q Name
forall {m :: * -> *} {b}.
(Monad m, Show b) =>
(m Type, b) -> m Name
getConstructorName [(Q Type, Integer)]
indexedTypes
      createTypeConstruct :: (m Type, b) -> m Con
createTypeConstruct (m Type
typ, b
n) = do
        Type
t <- m Type
typ
        Bang
bang' <- m SourceUnpackedness -> m SourceStrictness -> m Bang
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Bang
bang m SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness m SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness
        Name
haskellifiedName <- (m Type, b) -> m Name
forall {m :: * -> *} {b}.
(Monad m, Show b) =>
(m Type, b) -> m Name
getConstructorName (m Type
typ, b
n)
        Name -> [m BangType] -> m Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC Name
haskellifiedName [BangType -> m BangType
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bang
bang', Type
t)]
      createConstructorNameForSchemaWithFixedValue :: Value -> Name
createConstructorNameForSchemaWithFixedValue =
        Text -> Name
haskellifyConstructor
          (Text -> Name) -> (Value -> Text) -> Value -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)
          (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
aesonValueToName
      createConstructorForSchemaWithFixedValue :: Value -> Q Con
createConstructorForSchemaWithFixedValue =
        (Name -> [Q BangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
`normalC` [])
          (Name -> Q Con) -> (Value -> Name) -> Value -> Q Con
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Name
createConstructorNameForSchemaWithFixedValue
      fixedValueComments :: [Text]
fixedValueComments = (Value -> Text) -> [Value] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text
"Represents the JSON value @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@") (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Text
showAesonValue) [Value]
fixedValueSchemas
      emptyCtx :: Q [a]
emptyCtx = [a] -> Q [a]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      patternName :: Name
patternName = String -> Name
mkName String
"a"
      p :: Q Pat
p = Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
patternName
      e :: Q Exp
e = Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
patternName
      fromJsonFn :: Q Dec
fromJsonFn =
        let paramName :: Name
paramName = String -> Name
mkName String
"val"
            body :: Q Exp
body = do
              [Name]
constructorNames' <- [Q Name] -> Q [Name]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence [Q Name]
constructorNames
              let resultExpr :: Q Exp
resultExpr =
                    (Name -> Q Exp -> Q Exp) -> Q Exp -> [Name] -> Q Exp
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
                      ( \Name
constructorName Q Exp
expr ->
                          [|($(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
constructorName) <$> Aeson.fromJSON $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
paramName)) <|> $Q Exp
expr|]
                      )
                      [|Aeson.Error "No variant matched"|]
                      [Name]
constructorNames'
                  parserExpr :: Q Exp
parserExpr =
                    [|
                      case $Q Exp
resultExpr of
                        Aeson.Success $Q Pat
p -> pure $Q Exp
e
                        Aeson.Error $Q Pat
p -> fail $Q Exp
e
                      |]
              case [Value]
fixedValueSchemas of
                [] -> Q Exp
parserExpr
                [Value]
_ ->
                  [Q (Guard, Exp)] -> Q Exp
forall (m :: * -> *). Quote m => [m (Guard, Exp)] -> m Exp
multiIfE ([Q (Guard, Exp)] -> Q Exp) -> [Q (Guard, Exp)] -> Q Exp
forall a b. (a -> b) -> a -> b
$
                    (Value -> Q (Guard, Exp)) -> [Value] -> [Q (Guard, Exp)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                      ( \Value
value ->
                          let constructorName :: Name
constructorName = Value -> Name
createConstructorNameForSchemaWithFixedValue Value
value
                           in Q Exp -> Q Exp -> Q (Guard, Exp)
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m (Guard, Exp)
normalGE [|$(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
paramName) == $(Value -> Q Exp
liftAesonValue Value
value)|] [|pure $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
constructorName)|]
                      )
                      [Value]
fixedValueSchemas
                      [Q (Guard, Exp)] -> [Q (Guard, Exp)] -> [Q (Guard, Exp)]
forall a. Semigroup a => a -> a -> a
<> [Q Exp -> Q Exp -> Q (Guard, Exp)
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m (Guard, Exp)
normalGE [|otherwise|] Q Exp
parserExpr]
         in Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
              (String -> Name
mkName String
"parseJSON")
              [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                  [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
paramName]
                  (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB Q Exp
body)
                  []
              ]
      toJsonFnConstructor :: Q Name -> Q Dec
toJsonFnConstructor Q Name
constructorName = do
        Name
n <- Q Name
constructorName
        Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
          (String -> Name
mkName String
"toJSON")
          [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
              [Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
n [Q Pat
p]]
              (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB [|Aeson.toJSON $Q Exp
e|])
              []
          ]
      toJsonFnFixedValues :: Value -> Q Dec
toJsonFnFixedValues Value
value =
        let constructorName :: Name
constructorName = Value -> Name
createConstructorNameForSchemaWithFixedValue Value
value
         in Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
              (String -> Name
mkName String
"toJSON")
              [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                  [Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
constructorName []]
                  (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Body) -> Q Exp -> Q Body
forall a b. (a -> b) -> a -> b
$ Value -> Q Exp
liftAesonValue Value
value)
                  []
              ]
      toJsonFns :: [Q Dec]
toJsonFns =
        (Q Name -> Q Dec) -> [Q Name] -> [Q Dec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Q Name -> Q Dec
toJsonFnConstructor [Q Name]
constructorNames
          [Q Dec] -> [Q Dec] -> [Q Dec]
forall a. Semigroup a => a -> a -> a
<> (Value -> Q Dec) -> [Value] -> [Q Dec]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Q Dec
toJsonFnFixedValues [Value]
fixedValueSchemas
      dataDefinition :: Q Doc
dataDefinition =
        ( [Text] -> Doc
Doc.generateHaddockComment
            [ Text
"Defines the oneOf schema located at @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@ in the specification.",
              Text
"",
              Text
description
            ]
            Doc -> Doc -> Doc
$$
        )
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Doc -> Doc -> Doc
`Doc.sideBySide` (String -> Doc
text String
"" Doc -> Doc -> Doc
$$ [Text] -> Doc
Doc.sideComments [Text]
fixedValueComments))
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
Doc.reformatADT
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
          (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD
            Q Cxt
forall {a}. Q [a]
emptyCtx
            Name
name
            []
            Maybe Type
forall a. Maybe a
Nothing
            ((Value -> Q Con) -> [Value] -> [Q Con]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Q Con
createConstructorForSchemaWithFixedValue [Value]
fixedValueSchemas [Q Con] -> [Q Con] -> [Q Con]
forall a. Semigroup a => a -> a -> a
<> ((Q Type, Integer) -> Q Con) -> [(Q Type, Integer)] -> [Q Con]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Q Type, Integer) -> Q Con
forall {m :: * -> *} {b}. (Quote m, Show b) => (m Type, b) -> m Con
createTypeConstruct [(Q Type, Integer)]
indexedTypes)
            [ Maybe DerivStrategy -> [Q Type] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Type] -> m DerivClause
derivClause
                Maybe DerivStrategy
forall a. Maybe a
Nothing
                [ Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Show,
                  Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT ''Eq
                ]
            ]
      toJson :: Q Doc
toJson = Dec -> Doc
forall a. Ppr a => a -> Doc
ppr (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD Q Cxt
forall {a}. Q [a]
emptyCtx [t|Aeson.ToJSON $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name)|] [Q Dec]
toJsonFns
      fromJson :: Q Doc
fromJson = Dec -> Doc
forall a. Ppr a => a -> Doc
ppr (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD Q Cxt
forall {a}. Q [a]
emptyCtx [t|Aeson.FromJSON $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name)|] [Q Dec
fromJsonFn]
      innerRes :: TypeWithDeclaration
innerRes = (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name, (Q Doc
variantDefinitions Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
dataDefinition Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
toJson Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
fromJson, Models
dependencies))
  TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TypeWithDeclaration
innerRes

typeToSuffix :: Type -> Text
typeToSuffix :: Type -> Text
typeToSuffix (ConT Name
name') = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
name'
typeToSuffix (VarT Name
name') =
  let x :: Text
x = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Name -> String
nameBase Name
name'
   in if Text
x Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"[]" then Text
"List" else Text
x
typeToSuffix (AppT Type
type1 Type
type2) = Type -> Text
typeToSuffix Type
type1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
typeToSuffix Type
type2
typeToSuffix Type
x = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Type -> String
forall a. Show a => a -> String
show Type
x

-- | combines schemas so that it is usefull for a allOf fusion
fuseSchemasAllOf :: Text -> [OAS.Schema] -> OAM.Generator (Map.Map Text OAS.Schema, Set.Set Text)
fuseSchemasAllOf :: Text -> [Schema] -> Generator (Map Text Schema, Models)
fuseSchemasAllOf Text
schemaName [Schema]
schemas = do
  [(SchemaObject, Models)]
schemasWithDependencies <- (Schema -> Generator (Maybe (SchemaObject, Models)))
-> [Schema] -> Generator [(SchemaObject, Models)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (Text -> Schema -> Generator (Maybe (SchemaObject, Models))
resolveSchemaReference Text
schemaName) [Schema]
schemas
  let concreteSchemas :: [SchemaObject]
concreteSchemas = ((SchemaObject, Models) -> SchemaObject)
-> [(SchemaObject, Models)] -> [SchemaObject]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SchemaObject, Models) -> SchemaObject
forall a b. (a, b) -> a
fst [(SchemaObject, Models)]
schemasWithDependencies
  [(Map Text Schema, Models)]
subSchemaInformation <- (SchemaObject -> Generator (Map Text Schema, Models))
-> [SchemaObject] -> Generator [(Map Text Schema, Models)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Text -> SchemaObject -> Generator (Map Text Schema, Models)
getPropertiesForAllOf Text
schemaName) [SchemaObject]
concreteSchemas
  let propertiesCombined :: Map Text Schema
propertiesCombined = (Map Text Schema -> Map Text Schema -> Map Text Schema)
-> Map Text Schema -> [Map Text Schema] -> Map Text Schema
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Schema -> Schema -> Schema)
-> Map Text Schema -> Map Text Schema -> Map Text Schema
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Schema -> Schema -> Schema
forall a b. a -> b -> a
const) Map Text Schema
forall k a. Map k a
Map.empty (((Map Text Schema, Models) -> Map Text Schema)
-> [(Map Text Schema, Models)] -> [Map Text Schema]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Text Schema, Models) -> Map Text Schema
forall a b. (a, b) -> a
fst [(Map Text Schema, Models)]
subSchemaInformation)
  let requiredCombined :: Models
requiredCombined = (Models -> Models -> Models) -> Models -> [Models] -> Models
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Models -> Models -> Models
forall a. Ord a => Set a -> Set a -> Set a
Set.union Models
forall a. Set a
Set.empty (((Map Text Schema, Models) -> Models)
-> [(Map Text Schema, Models)] -> [Models]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Map Text Schema, Models) -> Models
forall a b. (a, b) -> b
snd [(Map Text Schema, Models)]
subSchemaInformation)
  (Map Text Schema, Models) -> Generator (Map Text Schema, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text Schema
propertiesCombined, Models
requiredCombined)

-- | gets properties for an allOf merge
-- looks if subschemas define further subschemas
getPropertiesForAllOf :: Text -> OAS.SchemaObject -> OAM.Generator (Map.Map Text OAS.Schema, Set.Set Text)
getPropertiesForAllOf :: Text -> SchemaObject -> Generator (Map Text Schema, Models)
getPropertiesForAllOf Text
schemaName SchemaObject
schema =
  let allOf :: [Schema]
allOf = SchemaObject -> [Schema]
OAS.schemaObjectAllOf SchemaObject
schema
      anyOf :: [Schema]
anyOf = SchemaObject -> [Schema]
OAS.schemaObjectAnyOf SchemaObject
schema
      relevantSubschemas :: [Schema]
relevantSubschemas = [Schema]
allOf [Schema] -> [Schema] -> [Schema]
forall a. Semigroup a => a -> a -> a
<> [Schema]
anyOf
   in if [Schema] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Schema]
relevantSubschemas
        then (Map Text Schema, Models) -> Generator (Map Text Schema, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SchemaObject -> Map Text Schema
OAS.schemaObjectProperties SchemaObject
schema, SchemaObject -> Models
OAS.schemaObjectRequired SchemaObject
schema)
        else do
          (Map Text Schema
allOfProps, Models
allOfRequired) <- Text -> [Schema] -> Generator (Map Text Schema, Models)
fuseSchemasAllOf Text
schemaName [Schema]
allOf
          (Map Text Schema
anyOfProps, Models
_) <- Text -> [Schema] -> Generator (Map Text Schema, Models)
fuseSchemasAllOf Text
schemaName [Schema]
anyOf
          (Map Text Schema, Models) -> Generator (Map Text Schema, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Schema -> Schema -> Schema)
-> Map Text Schema -> Map Text Schema -> Map Text Schema
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Schema -> Schema -> Schema
forall a b. a -> b -> a
const Map Text Schema
allOfProps Map Text Schema
anyOfProps, Models
allOfRequired)

-- | defines a allOf subschema
-- Fuses the subschemas together
defineAllOfSchema :: Text -> Text -> [OAS.Schema] -> OAM.Generator TypeWithDeclaration
defineAllOfSchema :: Text -> Text -> [Schema] -> Generator TypeWithDeclaration
defineAllOfSchema Text
schemaName Text
description [Schema]
schemas = do
  Maybe (SchemaObject, Models)
newDefs <- Text
-> Text -> [Schema] -> Generator (Maybe (SchemaObject, Models))
defineNewSchemaForAllOf Text
schemaName Text
description [Schema]
schemas
  case Maybe (SchemaObject, Models)
newDefs of
    Just (SchemaObject
newSchema, Models
newDependencies) ->
      Models
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
addDependencies Models
newDependencies (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineModelForSchemaConcrete TypeAliasStrategy
DontCreateTypeAlias Text
schemaName SchemaObject
newSchema
    Maybe (SchemaObject, Models)
Nothing -> TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([t|Aeson.Object|], (Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Models
forall a. Set a
Set.empty))

-- | defines a new Schema, which properties are fused
defineNewSchemaForAllOf :: Text -> Text -> [OAS.Schema] -> OAM.Generator (Maybe (OAS.SchemaObject, Dep.Models))
defineNewSchemaForAllOf :: Text
-> Text -> [Schema] -> Generator (Maybe (SchemaObject, Models))
defineNewSchemaForAllOf Text
schemaName Text
description [Schema]
schemas = do
  [(SchemaObject, Models)]
schemasWithDependencies <- (Schema -> Generator (Maybe (SchemaObject, Models)))
-> [Schema] -> Generator [(SchemaObject, Models)]
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM (Text -> Schema -> Generator (Maybe (SchemaObject, Models))
resolveSchemaReference Text
schemaName) [Schema]
schemas
  let concreteSchemas :: [SchemaObject]
concreteSchemas = ((SchemaObject, Models) -> SchemaObject)
-> [(SchemaObject, Models)] -> [SchemaObject]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SchemaObject, Models) -> SchemaObject
forall a b. (a, b) -> a
fst [(SchemaObject, Models)]
schemasWithDependencies
      newDependencies :: Models
newDependencies = [Models] -> Models
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Models] -> Models) -> [Models] -> Models
forall a b. (a -> b) -> a -> b
$ ((SchemaObject, Models) -> Models)
-> [(SchemaObject, Models)] -> [Models]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SchemaObject, Models) -> Models
forall a b. (a, b) -> b
snd [(SchemaObject, Models)]
schemasWithDependencies
  (Map Text Schema
propertiesCombined, Models
requiredCombined) <- Text -> [Schema] -> Generator (Map Text Schema, Models)
fuseSchemasAllOf Text
schemaName [Schema]
schemas
  if Map Text Schema -> Bool
forall k a. Map k a -> Bool
Map.null Map Text Schema
propertiesCombined
    then do
      Text -> Generator ()
OAM.logWarning Text
"allOf does not contain any schemas with properties."
      Maybe (SchemaObject, Models)
-> Generator (Maybe (SchemaObject, Models))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (SchemaObject, Models)
forall a. Maybe a
Nothing
    else do
      let schemaPrototype :: SchemaObject
schemaPrototype = [SchemaObject] -> SchemaObject
forall a. HasCallStack => [a] -> a
head [SchemaObject]
concreteSchemas
          newSchema :: SchemaObject
newSchema = SchemaObject
schemaPrototype {OAS.schemaObjectProperties = propertiesCombined, OAS.schemaObjectRequired = requiredCombined, OAS.schemaObjectDescription = Just description}
      Text -> Generator ()
OAM.logTrace (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Define allOf as record named '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
      Maybe (SchemaObject, Models)
-> Generator (Maybe (SchemaObject, Models))
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (SchemaObject, Models)
 -> Generator (Maybe (SchemaObject, Models)))
-> Maybe (SchemaObject, Models)
-> Generator (Maybe (SchemaObject, Models))
forall a b. (a -> b) -> a -> b
$ (SchemaObject, Models) -> Maybe (SchemaObject, Models)
forall a. a -> Maybe a
Just (SchemaObject
newSchema, Models
newDependencies)

-- | defines an array
defineArrayModelForSchema :: TypeAliasStrategy -> Text -> OAS.SchemaObject -> OAM.Generator TypeWithDeclaration
defineArrayModelForSchema :: TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineArrayModelForSchema TypeAliasStrategy
strategy Text
schemaName SchemaObject
schema = do
  Text
arrayItemTypeSuffix <- case TypeAliasStrategy
strategy of
    TypeAliasStrategy
CreateTypeAlias -> (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingArrayItemTypeSuffix
    TypeAliasStrategy
DontCreateTypeAlias -> Text -> Generator Text
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
"" -- The suffix is only relevant for top level declarations because only there a named type of the array even exists
  (Q Type
type', (Q Doc
content, Models
dependencies)) <-
    case SchemaObject -> Maybe Schema
OAS.schemaObjectItems SchemaObject
schema of
      Just Schema
itemSchema -> Text
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"items" (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamed (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
arrayItemTypeSuffix) Schema
itemSchema
      -- not allowed by the spec
      Maybe Schema
Nothing -> do
        Text -> Generator ()
OAM.logWarning Text
"Array type was defined without a items schema and therefore cannot be defined correctly"
        TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([t|Aeson.Object|], (Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Models
forall a. Set a
Set.empty))
  let arrayType :: Q Type
arrayType =
        case SchemaObject -> Maybe Word
OAS.schemaObjectMinItems SchemaObject
schema of
          Just Word
w | Word
w Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 -> Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT [t|NonEmpty|] Q Type
type'
          Maybe Word
_ -> Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT Q Type
forall (m :: * -> *). Quote m => m Type
listT Q Type
type'
  Name
schemaName' <- Bool -> Text -> Generator Name
haskellifyNameM Bool
True Text
schemaName
  Text -> Generator ()
OAM.logTrace (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Define as list named '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Name -> String
nameBase Name
schemaName') Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
  Text
path <- Generator Text
getCurrentPathEscaped
  TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Q Type
arrayType,
      ( Q Doc
content Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` case TypeAliasStrategy
strategy of
          TypeAliasStrategy
CreateTypeAlias ->
            ( [Text] -> Doc
Doc.generateHaddockComment
                [ Text
"Defines an alias for the schema located at @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@ in the specification.",
                  Text
"",
                  SchemaObject -> Text
getDescriptionOfSchema SchemaObject
schema
                ]
                Doc -> Doc -> Doc
$$
            )
              (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
              (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name -> [TyVarBndr ()] -> Q Type -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> [TyVarBndr ()] -> m Type -> m Dec
tySynD Name
schemaName' [] Q Type
arrayType
          TypeAliasStrategy
DontCreateTypeAlias -> Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc,
        Models
dependencies
      )
    )

data Field = Field
  { Field -> Text
fieldProp :: Text,
    Field -> Text
fieldName :: Text,
    Field -> Schema
fieldSchema :: OAS.Schema,
    Field -> Bool
fieldRequired :: Bool,
    Field -> Name
fieldHaskellName :: Name
  }

toField :: Bool -> Text -> Text -> OAS.Schema -> Set.Set Text -> Field
toField :: Bool -> Text -> Text -> Schema -> Models -> Field
toField Bool
convertToCamelCase Text
propName Text
fieldName Schema
fieldSchema Models
required =
  Field
    { fieldProp :: Text
fieldProp = Text
propName,
      Text
fieldName :: Text
fieldName :: Text
fieldName,
      Schema
fieldSchema :: Schema
fieldSchema :: Schema
fieldSchema,
      fieldRequired :: Bool
fieldRequired = Text
propName Text -> Models -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Models
required,
      fieldHaskellName :: Name
fieldHaskellName = Bool -> Bool -> Text -> Name
haskellifyName Bool
convertToCamelCase Bool
False Text
fieldName
    }

-- | Defines a record
defineObjectModelForSchema :: TypeAliasStrategy -> Text -> OAS.SchemaObject -> OAM.Generator TypeWithDeclaration
defineObjectModelForSchema :: TypeAliasStrategy
-> Text -> SchemaObject -> Generator TypeWithDeclaration
defineObjectModelForSchema TypeAliasStrategy
strategy Text
schemaName SchemaObject
schema =
  if SchemaObject -> Bool
OAS.isSchemaEmpty SchemaObject
schema
    then Text
-> Text
-> TypeAliasStrategy
-> Generator TypeWithDeclaration
-> Generator TypeWithDeclaration
createAlias Text
schemaName (SchemaObject -> Text
getDescriptionOfSchema SchemaObject
schema) TypeAliasStrategy
strategy (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([t|Aeson.Object|], (Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Models
forall a. Set a
Set.empty))
    else do
      Settings
settings <- Generator Settings
OAM.getSettings
      Text
path <- Generator Text
getCurrentPathEscaped
      let convertToCamelCase :: Bool
convertToCamelCase = Settings -> Bool
OAO.settingConvertToCamelCase Settings
settings
          name :: Name
name = Bool -> Bool -> Text -> Name
haskellifyName Bool
convertToCamelCase Bool
True Text
schemaName
          required :: Models
required = SchemaObject -> Models
OAS.schemaObjectRequired SchemaObject
schema
          fixedValueStrategy :: FixedValueStrategy
fixedValueStrategy = Settings -> FixedValueStrategy
OAO.settingFixedValueStrategy Settings
settings
          shortenSingleFieldObjects :: Bool
shortenSingleFieldObjects = Settings -> Bool
OAO.settingShortenSingleFieldObjects Settings
settings
          ([(Text, Schema)]
props, [(Text, Value)]
propsWithFixedValues) = FixedValueStrategy
-> Models
-> [(Text, Schema)]
-> ([(Text, Schema)], [(Text, Value)])
extractPropertiesWithFixedValues FixedValueStrategy
fixedValueStrategy Models
required ([(Text, Schema)] -> ([(Text, Schema)], [(Text, Value)]))
-> [(Text, Schema)] -> ([(Text, Schema)], [(Text, Value)])
forall a b. (a -> b) -> a -> b
$ Map Text Schema -> [(Text, Schema)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text Schema -> [(Text, Schema)])
-> Map Text Schema -> [(Text, Schema)]
forall a b. (a -> b) -> a -> b
$ SchemaObject -> Map Text Schema
OAS.schemaObjectProperties SchemaObject
schema
          propFields :: [(Text, Field)]
propFields = case [(Text, Schema)]
props of
            [(Text
propName, Schema
subschema)]
              | Bool
shortenSingleFieldObjects ->
                  [(Text
propName, Bool -> Text -> Text -> Schema -> Models -> Field
toField Bool
convertToCamelCase Text
propName Text
schemaName Schema
subschema Models
required)]
            [(Text, Schema)]
_ -> (((Text, Schema) -> (Text, Field))
 -> [(Text, Schema)] -> [(Text, Field)])
-> [(Text, Schema)]
-> ((Text, Schema) -> (Text, Field))
-> [(Text, Field)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((Text, Schema) -> (Text, Field))
-> [(Text, Schema)] -> [(Text, Field)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(Text, Schema)]
props (((Text, Schema) -> (Text, Field)) -> [(Text, Field)])
-> ((Text, Schema) -> (Text, Field)) -> [(Text, Field)]
forall a b. (a -> b) -> a -> b
$ \(Text
propName, Schema
subschema) ->
              (Text
propName, Bool -> Text -> Text -> Schema -> Models -> Field
toField Bool
convertToCamelCase Text
propName (Text
schemaName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
uppercaseFirstText Text
propName) Schema
subschema Models
required)
          emptyCtx :: Q [a]
emptyCtx = [a] -> Q [a]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      Text -> Generator ()
OAM.logInfo (Text -> Generator ()) -> Text -> Generator ()
forall a b. (a -> b) -> a -> b
$ Text
"Define as record named '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Name -> String
nameBase Name
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
      (Q [VarBangType]
bangTypes, Q Doc
propertyContent, Models
propertyDependencies) <- [(Text, Field)] -> Generator (Q [VarBangType], Q Doc, Models)
propertiesToBangTypes [(Text, Field)]
propFields
      [Text]
propertyDescriptions <- [(Text, Field)] -> Generator [Text]
getDescriptionOfProperties [(Text, Field)]
propFields
      let dataDefinition :: Q Doc
dataDefinition = do
            [VarBangType]
bangs <- Q [VarBangType]
bangTypes
            let record :: Q Con
record = Name -> [Q VarBangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m VarBangType] -> m Con
recC Name
name (VarBangType -> Q VarBangType
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (VarBangType -> Q VarBangType) -> [VarBangType] -> [Q VarBangType]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [VarBangType]
bangs)
            ([Text] -> [Text] -> Doc) -> [Text] -> [Text] -> Doc
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Text] -> [Text] -> Doc
Doc.zipCodeAndComments [Text]
propertyDescriptions
              ([Text] -> Doc) -> (Dec -> [Text]) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines
              (Text -> [Text]) -> (Dec -> Text) -> Dec -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
              (String -> Text) -> (Dec -> String) -> Dec -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> String
forall a. Show a => a -> String
show
              (Doc -> String) -> (Dec -> Doc) -> Dec -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> Doc
Doc.reformatRecord
              (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
              (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [Q Con]
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> [m Con]
-> [m DerivClause]
-> m Dec
dataD Q Cxt
forall {a}. Q [a]
emptyCtx Name
name [] Maybe Type
forall a. Maybe a
Nothing [Q Con
record] [Q DerivClause]
objectDeriveClause
          toJsonInstance :: Q Doc
toJsonInstance = Name -> [(Text, Field)] -> [(Text, Value)] -> Q Doc
createToJSONImplementation Name
name [(Text, Field)]
propFields [(Text, Value)]
propsWithFixedValues
          fromJsonInstance :: Q Doc
fromJsonInstance = Name -> [(Text, Field)] -> Q Doc
createFromJSONImplementation Name
name [(Text, Field)]
propFields
          mkFunction :: Q Doc
mkFunction = Name -> [(Text, Field)] -> Q [VarBangType] -> Q Doc
createMkFunction Name
name [(Text, Field)]
propFields Q [VarBangType]
bangTypes
      TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        ( Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
name,
          ( Doc -> Q Doc
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              ( [Text] -> Doc
Doc.generateHaddockComment
                  [ Text
"Defines the object schema located at @" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"@ in the specification.",
                    Text
"",
                    SchemaObject -> Text
getDescriptionOfSchema SchemaObject
schema
                  ]
              )
              Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
dataDefinition
              Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
toJsonInstance
              Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
fromJsonInstance
              Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
mkFunction
              Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
propertyContent,
            Models
propertyDependencies
          )
        )

extractPropertiesWithFixedValues :: FixedValueStrategy -> Set.Set Text -> [(Text, OAS.Schema)] -> ([(Text, OAS.Schema)], [(Text, Aeson.Value)])
extractPropertiesWithFixedValues :: FixedValueStrategy
-> Models
-> [(Text, Schema)]
-> ([(Text, Schema)], [(Text, Value)])
extractPropertiesWithFixedValues FixedValueStrategy
fixedValueStrategy Models
required =
  [Either (Text, Schema) (Text, Value)]
-> ([(Text, Schema)], [(Text, Value)])
forall a b. [Either a b] -> ([a], [b])
E.partitionEithers
    ([Either (Text, Schema) (Text, Value)]
 -> ([(Text, Schema)], [(Text, Value)]))
-> ([(Text, Schema)] -> [Either (Text, Schema) (Text, Value)])
-> [(Text, Schema)]
-> ([(Text, Schema)], [(Text, Value)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Schema) -> Either (Text, Schema) (Text, Value))
-> [(Text, Schema)] -> [Either (Text, Schema) (Text, Value)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( \(Text
name, Schema
schema) ->
          (Schema -> (Text, Schema))
-> (Value -> (Text, Value))
-> Either Schema Value
-> Either (Text, Schema) (Text, Value)
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
BF.bimap (Text
name,) (Text
name,) (Either Schema Value -> Either (Text, Schema) (Text, Value))
-> Either Schema Value -> Either (Text, Schema) (Text, Value)
forall a b. (a -> b) -> a -> b
$
            if Text
name Text -> Models -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Models
required
              then FixedValueStrategy -> Schema -> Either Schema Value
extractSchemaWithFixedValue FixedValueStrategy
fixedValueStrategy Schema
schema
              else Schema -> Either Schema Value
forall a b. a -> Either a b
Left Schema
schema
      )

extractSchemasWithFixedValues :: FixedValueStrategy -> [OAS.Schema] -> ([OAS.Schema], [Aeson.Value])
extractSchemasWithFixedValues :: FixedValueStrategy -> [Schema] -> ([Schema], [Value])
extractSchemasWithFixedValues FixedValueStrategy
fixedValueStrategy =
  [Either Schema Value] -> ([Schema], [Value])
forall a b. [Either a b] -> ([a], [b])
E.partitionEithers ([Either Schema Value] -> ([Schema], [Value]))
-> ([Schema] -> [Either Schema Value])
-> [Schema]
-> ([Schema], [Value])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Either Schema Value)
-> [Schema] -> [Either Schema Value]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FixedValueStrategy -> Schema -> Either Schema Value
extractSchemaWithFixedValue FixedValueStrategy
fixedValueStrategy)

extractSchemaWithFixedValue :: FixedValueStrategy -> OAS.Schema -> Either OAS.Schema Aeson.Value
extractSchemaWithFixedValue :: FixedValueStrategy -> Schema -> Either Schema Value
extractSchemaWithFixedValue FixedValueStrategy
FixedValueStrategyExclude schema :: Schema
schema@(OAT.Concrete OAS.SchemaObject {Bool
[Value]
[Schema]
Maybe Float
Maybe Word
Maybe Value
Maybe Text
Maybe ExternalDocumentationObject
Maybe Schema
Maybe XMLObject
Maybe ConcreteValue
Maybe DiscriminatorObject
Map Text Schema
Models
AdditionalProperties
SchemaType
schemaObjectEnum :: SchemaObject -> [Value]
schemaObjectNullable :: SchemaObject -> Bool
schemaObjectType :: SchemaObject -> SchemaType
schemaObjectAllOf :: SchemaObject -> [Schema]
schemaObjectOneOf :: SchemaObject -> [Schema]
schemaObjectAnyOf :: SchemaObject -> [Schema]
schemaObjectRequired :: SchemaObject -> Models
schemaObjectProperties :: SchemaObject -> Map Text Schema
schemaObjectDescription :: SchemaObject -> Maybe Text
schemaObjectItems :: SchemaObject -> Maybe Schema
schemaObjectMinItems :: SchemaObject -> Maybe Word
schemaObjectType :: SchemaType
schemaObjectTitle :: Maybe Text
schemaObjectMultipleOf :: Maybe Float
schemaObjectMaximum :: Maybe Float
schemaObjectExclusiveMaximum :: Bool
schemaObjectMinimum :: Maybe Float
schemaObjectExclusiveMinimum :: Bool
schemaObjectMaxLength :: Maybe Word
schemaObjectMinLength :: Maybe Word
schemaObjectPattern :: Maybe Text
schemaObjectMaxItems :: Maybe Word
schemaObjectMinItems :: Maybe Word
schemaObjectUniqueItems :: Bool
schemaObjectMaxProperties :: Maybe Word
schemaObjectMinProperties :: Maybe Word
schemaObjectRequired :: Models
schemaObjectEnum :: [Value]
schemaObjectAllOf :: [Schema]
schemaObjectOneOf :: [Schema]
schemaObjectAnyOf :: [Schema]
schemaObjectNot :: Maybe Schema
schemaObjectProperties :: Map Text Schema
schemaObjectAdditionalProperties :: AdditionalProperties
schemaObjectDescription :: Maybe Text
schemaObjectFormat :: Maybe Text
schemaObjectDefault :: Maybe ConcreteValue
schemaObjectNullable :: Bool
schemaObjectDiscriminator :: Maybe DiscriminatorObject
schemaObjectReadOnly :: Bool
schemaObjectWriteOnly :: Bool
schemaObjectXml :: Maybe XMLObject
schemaObjectExternalDocs :: Maybe ExternalDocumentationObject
schemaObjectExample :: Maybe Value
schemaObjectDeprecated :: Bool
schemaObjectItems :: Maybe Schema
schemaObjectTitle :: SchemaObject -> Maybe Text
schemaObjectMultipleOf :: SchemaObject -> Maybe Float
schemaObjectMaximum :: SchemaObject -> Maybe Float
schemaObjectExclusiveMaximum :: SchemaObject -> Bool
schemaObjectMinimum :: SchemaObject -> Maybe Float
schemaObjectExclusiveMinimum :: SchemaObject -> Bool
schemaObjectMaxLength :: SchemaObject -> Maybe Word
schemaObjectMinLength :: SchemaObject -> Maybe Word
schemaObjectPattern :: SchemaObject -> Maybe Text
schemaObjectMaxItems :: SchemaObject -> Maybe Word
schemaObjectUniqueItems :: SchemaObject -> Bool
schemaObjectMaxProperties :: SchemaObject -> Maybe Word
schemaObjectMinProperties :: SchemaObject -> Maybe Word
schemaObjectNot :: SchemaObject -> Maybe Schema
schemaObjectAdditionalProperties :: SchemaObject -> AdditionalProperties
schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectDefault :: SchemaObject -> Maybe ConcreteValue
schemaObjectDiscriminator :: SchemaObject -> Maybe DiscriminatorObject
schemaObjectReadOnly :: SchemaObject -> Bool
schemaObjectWriteOnly :: SchemaObject -> Bool
schemaObjectXml :: SchemaObject -> Maybe XMLObject
schemaObjectExternalDocs :: SchemaObject -> Maybe ExternalDocumentationObject
schemaObjectExample :: SchemaObject -> Maybe Value
schemaObjectDeprecated :: SchemaObject -> Bool
..}) = case [Value]
schemaObjectEnum of
  [Value
value] -> Value -> Either Schema Value
forall a b. b -> Either a b
Right Value
value
  [Value]
_ -> Schema -> Either Schema Value
forall a b. a -> Either a b
Left Schema
schema
extractSchemaWithFixedValue FixedValueStrategy
_ Schema
schema = Schema -> Either Schema Value
forall a b. a -> Either a b
Left Schema
schema

extractSchemasWithSingleField :: [OAS.Schema] -> ([OAS.Schema], [(Text, OAS.Schema)])
extractSchemasWithSingleField :: [Schema] -> ([Schema], [(Text, Schema)])
extractSchemasWithSingleField = [Either Schema (Text, Schema)] -> ([Schema], [(Text, Schema)])
forall a b. [Either a b] -> ([a], [b])
E.partitionEithers ([Either Schema (Text, Schema)] -> ([Schema], [(Text, Schema)]))
-> ([Schema] -> [Either Schema (Text, Schema)])
-> [Schema]
-> ([Schema], [(Text, Schema)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Schema -> Either Schema (Text, Schema))
-> [Schema] -> [Either Schema (Text, Schema)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Schema -> Either Schema (Text, Schema)
extractSchemaWithSingleField

extractSchemaWithSingleField :: OAS.Schema -> Either OAS.Schema (Text, OAS.Schema)
extractSchemaWithSingleField :: Schema -> Either Schema (Text, Schema)
extractSchemaWithSingleField schema :: Schema
schema@(OAT.Concrete OAS.SchemaObject {Bool
[Value]
[Schema]
Maybe Float
Maybe Word
Maybe Value
Maybe Text
Maybe ExternalDocumentationObject
Maybe Schema
Maybe XMLObject
Maybe ConcreteValue
Maybe DiscriminatorObject
Map Text Schema
Models
AdditionalProperties
SchemaType
schemaObjectEnum :: SchemaObject -> [Value]
schemaObjectNullable :: SchemaObject -> Bool
schemaObjectType :: SchemaObject -> SchemaType
schemaObjectAllOf :: SchemaObject -> [Schema]
schemaObjectOneOf :: SchemaObject -> [Schema]
schemaObjectAnyOf :: SchemaObject -> [Schema]
schemaObjectRequired :: SchemaObject -> Models
schemaObjectProperties :: SchemaObject -> Map Text Schema
schemaObjectDescription :: SchemaObject -> Maybe Text
schemaObjectItems :: SchemaObject -> Maybe Schema
schemaObjectMinItems :: SchemaObject -> Maybe Word
schemaObjectTitle :: SchemaObject -> Maybe Text
schemaObjectMultipleOf :: SchemaObject -> Maybe Float
schemaObjectMaximum :: SchemaObject -> Maybe Float
schemaObjectExclusiveMaximum :: SchemaObject -> Bool
schemaObjectMinimum :: SchemaObject -> Maybe Float
schemaObjectExclusiveMinimum :: SchemaObject -> Bool
schemaObjectMaxLength :: SchemaObject -> Maybe Word
schemaObjectMinLength :: SchemaObject -> Maybe Word
schemaObjectPattern :: SchemaObject -> Maybe Text
schemaObjectMaxItems :: SchemaObject -> Maybe Word
schemaObjectUniqueItems :: SchemaObject -> Bool
schemaObjectMaxProperties :: SchemaObject -> Maybe Word
schemaObjectMinProperties :: SchemaObject -> Maybe Word
schemaObjectNot :: SchemaObject -> Maybe Schema
schemaObjectAdditionalProperties :: SchemaObject -> AdditionalProperties
schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectDefault :: SchemaObject -> Maybe ConcreteValue
schemaObjectDiscriminator :: SchemaObject -> Maybe DiscriminatorObject
schemaObjectReadOnly :: SchemaObject -> Bool
schemaObjectWriteOnly :: SchemaObject -> Bool
schemaObjectXml :: SchemaObject -> Maybe XMLObject
schemaObjectExternalDocs :: SchemaObject -> Maybe ExternalDocumentationObject
schemaObjectExample :: SchemaObject -> Maybe Value
schemaObjectDeprecated :: SchemaObject -> Bool
schemaObjectType :: SchemaType
schemaObjectTitle :: Maybe Text
schemaObjectMultipleOf :: Maybe Float
schemaObjectMaximum :: Maybe Float
schemaObjectExclusiveMaximum :: Bool
schemaObjectMinimum :: Maybe Float
schemaObjectExclusiveMinimum :: Bool
schemaObjectMaxLength :: Maybe Word
schemaObjectMinLength :: Maybe Word
schemaObjectPattern :: Maybe Text
schemaObjectMaxItems :: Maybe Word
schemaObjectMinItems :: Maybe Word
schemaObjectUniqueItems :: Bool
schemaObjectMaxProperties :: Maybe Word
schemaObjectMinProperties :: Maybe Word
schemaObjectRequired :: Models
schemaObjectEnum :: [Value]
schemaObjectAllOf :: [Schema]
schemaObjectOneOf :: [Schema]
schemaObjectAnyOf :: [Schema]
schemaObjectNot :: Maybe Schema
schemaObjectProperties :: Map Text Schema
schemaObjectAdditionalProperties :: AdditionalProperties
schemaObjectDescription :: Maybe Text
schemaObjectFormat :: Maybe Text
schemaObjectDefault :: Maybe ConcreteValue
schemaObjectNullable :: Bool
schemaObjectDiscriminator :: Maybe DiscriminatorObject
schemaObjectReadOnly :: Bool
schemaObjectWriteOnly :: Bool
schemaObjectXml :: Maybe XMLObject
schemaObjectExternalDocs :: Maybe ExternalDocumentationObject
schemaObjectExample :: Maybe Value
schemaObjectDeprecated :: Bool
schemaObjectItems :: Maybe Schema
..}) = case Map Text Schema -> [(Text, Schema)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Schema
schemaObjectProperties of
  [(Text
field, Schema
_)] -> (Text, Schema) -> Either Schema (Text, Schema)
forall a b. b -> Either a b
Right (Text
field, Schema
schema)
  [(Text, Schema)]
_ -> Schema -> Either Schema (Text, Schema)
forall a b. a -> Either a b
Left Schema
schema
extractSchemaWithSingleField Schema
schema = Schema -> Either Schema (Text, Schema)
forall a b. a -> Either a b
Left Schema
schema

createMkFunction :: Name -> [(Text, Field)] -> Q [VarBangType] -> Q Doc
createMkFunction :: Name -> [(Text, Field)] -> Q [VarBangType] -> Q Doc
createMkFunction Name
name [(Text, Field)]
propFields Q [VarBangType]
bangTypes = do
  [VarBangType]
bangs <- Q [VarBangType]
bangTypes
  let fnName :: Name
fnName = String -> Name
mkName (String -> Name) -> String -> Name
forall a b. (a -> b) -> a -> b
$ String
"mk" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Name -> String
nameBase Name
name
      fieldsWithBangs :: [(Field, Type)]
fieldsWithBangs =
        ( \((Text
_, Field
record), (Name
_, Bang
_, Type
propType)) ->
            (Field
record, Type
propType)
        )
          (((Text, Field), VarBangType) -> (Field, Type))
-> [((Text, Field), VarBangType)] -> [(Field, Type)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Field)] -> [VarBangType] -> [((Text, Field), VarBangType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(Text, Field)]
propFields [VarBangType]
bangs
      requiredFieldsWithBangs :: [(Field, Type)]
requiredFieldsWithBangs = ((Field, Type) -> Bool) -> [(Field, Type)] -> [(Field, Type)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..}, Type
_) -> Bool
fieldRequired) [(Field, Type)]
fieldsWithBangs
      parameterPatterns :: [Q Pat]
parameterPatterns = (\(Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..}, Type
_) -> Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
fieldHaskellName) ((Field, Type) -> Q Pat) -> [(Field, Type)] -> [Q Pat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Field, Type)]
requiredFieldsWithBangs
      parameterDescriptions :: [Text]
parameterDescriptions = (\(Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..}, Type
_) -> Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Name -> String
nameBase Name
fieldHaskellName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'") ((Field, Type) -> Text) -> [(Field, Type)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Field, Type)]
requiredFieldsWithBangs
      recordExpr :: [Q (Name, Exp)]
recordExpr = (\(Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..}, Type
_) -> Name -> Q Exp -> Q (Name, Exp)
forall (m :: * -> *). Quote m => Name -> m Exp -> m (Name, Exp)
fieldExp Name
fieldHaskellName (if Bool
fieldRequired then Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
fieldHaskellName else [|Nothing|])) ((Field, Type) -> Q (Name, Exp))
-> [(Field, Type)] -> [Q (Name, Exp)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Field, Type)]
fieldsWithBangs
      expr :: Q Exp
expr = Name -> [Q (Name, Exp)] -> Q Exp
forall (m :: * -> *). Quote m => Name -> [m (Name, Exp)] -> m Exp
recConE Name
name [Q (Name, Exp)]
recordExpr
      fnType :: Q Type
fnType = ((Field, Type) -> Q Type -> Q Type)
-> Q Type -> [(Field, Type)] -> Q Type
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Field
_, Type
propertyType) Q Type
t -> [t|$(Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
propertyType) -> $Q Type
t|]) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
name) [(Field, Type)]
requiredFieldsWithBangs

  Doc -> Q Doc
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( [Text] -> Doc
Doc.generateHaddockComment
        [ Text
"Create a new '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Name -> String
nameBase Name
name) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' with all required fields."
        ]
    )
    Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` (Dec -> Doc) -> Q Dec -> Q Doc
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
      ( ( Doc -> Doc -> Doc
`Doc.sideBySide`
            [Text] -> Doc
Doc.sideComments [Text]
parameterDescriptions
        )
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Doc -> Doc
Doc.breakOnTokens [Text
"->"]
          (Doc -> Doc) -> (Dec -> Doc) -> Dec -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
      )
      (Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
fnName Q Type
fnType)
    Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` (Dec -> Doc) -> Q Dec -> Q Doc
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dec -> Doc
forall a. Ppr a => a -> Doc
ppr (Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
fnName [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Q Pat]
parameterPatterns (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB Q Exp
expr) []])

-- | create toJSON implementation for an object
createToJSONImplementation :: Name -> [(Text, Field)] -> [(Text, Aeson.Value)] -> Q Doc
createToJSONImplementation :: Name -> [(Text, Field)] -> [(Text, Value)] -> Q Doc
createToJSONImplementation Name
objectName [(Text, Field)]
fieldProps [(Text, Value)]
propsWithFixedValues =
  let emptyDefs :: Q [a]
emptyDefs = [a] -> Q [a]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
      fnArgName :: Name
fnArgName = String -> Name
mkName String
"obj"
      toAssertion :: (Text, Field) -> m Exp
toAssertion (Text
propName, Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..}) =
        if Bool
fieldRequired
          then [|[$(String -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> m Exp) -> String -> m Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
propName) Aeson..= $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
fieldHaskellName) $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
fnArgName)]|]
          else [|(maybe mempty (pure . ($(String -> m Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> m Exp) -> String -> m Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
propName) Aeson..=)) ($(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
fieldHaskellName) $(Name -> m Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
fnArgName)))|]
      toFixedAssertion :: (Text, Value) -> Q Exp
toFixedAssertion (Text
propName, Value
value) =
        [|[$(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
propName) Aeson..= $(Bool -> Value -> Q Exp
liftAesonValueWithOverloadedStrings Bool
False Value
value)]|]
      assertions :: [Q Exp]
assertions = ((Text, Field) -> Q Exp) -> [(Text, Field)] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Field) -> Q Exp
forall {m :: * -> *}. Quote m => (Text, Field) -> m Exp
toAssertion [(Text, Field)]
fieldProps [Q Exp] -> [Q Exp] -> [Q Exp]
forall a. Semigroup a => a -> a -> a
<> ((Text, Value) -> Q Exp) -> [(Text, Value)] -> [Q Exp]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Value) -> Q Exp
toFixedAssertion [(Text, Value)]
propsWithFixedValues
      assertionsList :: Q Exp
assertionsList = [|(List.concat $([Q Exp] -> Q Exp
toExprList [Q Exp]
assertions))|]
      toExprList :: [Q Exp] -> Q Exp
toExprList = (Q Exp -> Q Exp -> Q Exp) -> Q Exp -> [Q Exp] -> Q Exp
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Q Exp
x Q Exp
expr -> Q Exp -> Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp -> m Exp
uInfixE Q Exp
x (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (Name -> Q Exp) -> Name -> Q Exp
forall a b. (a -> b) -> a -> b
$ String -> Name
mkName String
":") Q Exp
expr) [|mempty|]
      defaultJsonImplementation :: [Q Dec]
defaultJsonImplementation =
        [ Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
            (String -> Name
mkName String
"toJSON")
            [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
fnArgName]
                ( Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
                    [|Aeson.object $Q Exp
assertionsList|]
                )
                []
            ],
          Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
            (String -> Name
mkName String
"toEncoding")
            [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
fnArgName]
                ( Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
                    [|Aeson.pairs (mconcat $Q Exp
assertionsList)|]
                )
                []
            ]
        ]
   in Dec -> Doc
forall a. Ppr a => a -> Doc
ppr (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD Q Cxt
forall {a}. Q [a]
emptyDefs [t|Aeson.ToJSON $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
objectName)|] [Q Dec]
defaultJsonImplementation

-- | create FromJSON implementation for an object
createFromJSONImplementation :: Name -> [(Text, Field)] -> Q Doc
createFromJSONImplementation :: Name -> [(Text, Field)] -> Q Doc
createFromJSONImplementation Name
objectName [(Text, Field)]
fieldProps =
  let fnArgName :: Name
fnArgName = String -> Name
mkName String
"obj"
      withObjectLamda :: Q Exp
withObjectLamda =
        (Q Exp -> (Text, Field) -> Q Exp)
-> Q Exp -> [(Text, Field)] -> Q Exp
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl
          ( \Q Exp
prev (Text
_, Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..}) ->
              let fieldProp' :: Q Exp
fieldProp' = String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fieldProp
                  arg :: Q Exp
arg = Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
fnArgName
                  readPropE :: Q Exp
readPropE =
                    if Bool
fieldRequired
                      then [|$Q Exp
arg Aeson..: $Q Exp
fieldProp'|]
                      else [|$Q Exp
arg Aeson..:! $Q Exp
fieldProp'|]
               in [|$Q Exp
prev <*> $Q Exp
readPropE|]
          )
          [|pure $(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
objectName)|]
          [(Text, Field)]
fieldProps
   in Dec -> Doc
forall a. Ppr a => a -> Doc
ppr
        (Dec -> Doc) -> Q Dec -> Q Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
          ([Q Type] -> Q Cxt
forall (m :: * -> *). Quote m => [m Type] -> m Cxt
cxt [])
          [t|Aeson.FromJSON $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
objectName)|]
          [ Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
              (String -> Name
mkName String
"parseJSON")
              [ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
                  []
                  ( Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
                      [|Aeson.withObject $(String -> Q Exp
forall (m :: * -> *). Quote m => String -> m Exp
stringE (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ Name -> String
forall a. Show a => a -> String
show Name
objectName) $(Q Pat -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Pat -> m Exp -> m Exp
lam1E (Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
fnArgName) Q Exp
withObjectLamda)|]
                  )
                  []
              ]
          ]

-- | create "bangs" record fields for properties
propertiesToBangTypes :: [(Text, Field)] -> OAM.Generator BangTypesSelfDefined
propertiesToBangTypes :: [(Text, Field)] -> Generator (Q [VarBangType], Q Doc, Models)
propertiesToBangTypes [] = (Q [VarBangType], Q Doc, Models)
-> Generator (Q [VarBangType], Q Doc, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VarBangType] -> Q [VarBangType]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [], Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Models
forall a. Set a
Set.empty)
propertiesToBangTypes [(Text, Field)]
fieldProps = Text
-> Generator (Q [VarBangType], Q Doc, Models)
-> Generator (Q [VarBangType], Q Doc, Models)
forall a. Text -> Generator a -> Generator a
OAM.nested Text
"properties" (Generator (Q [VarBangType], Q Doc, Models)
 -> Generator (Q [VarBangType], Q Doc, Models))
-> Generator (Q [VarBangType], Q Doc, Models)
-> Generator (Q [VarBangType], Q Doc, Models)
forall a b. (a -> b) -> a -> b
$ do
  Bool
convertToCamelCase <- (Settings -> Bool) -> Generator Bool
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Bool
OAO.settingConvertToCamelCase
  Text
propTypeSuffix <- (Settings -> Text) -> Generator Text
forall a. (Settings -> a) -> Generator a
OAM.getSetting Settings -> Text
OAO.settingPropertyTypeSuffix
  let createBang :: Field -> Q Type -> Q VarBangType
      createBang :: Field -> Q Type -> Q VarBangType
createBang Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..} Q Type
myType = do
        Bang
bang' <- Q SourceUnpackedness -> Q SourceStrictness -> Q Bang
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Bang
bang Q SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness Q SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness
        Type
type' <-
          if Bool
fieldRequired
            then Q Type
myType
            else Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT ''Maybe) Q Type
myType
        VarBangType -> Q VarBangType
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Bool -> Text -> Name
haskellifyName Bool
convertToCamelCase Bool
False Text
fieldName, Bang
bang', Type
type')
      propToBangType :: Field -> OAM.Generator (Q VarBangType, Q Doc, Dep.Models)
      propToBangType :: Field -> Generator (Q VarBangType, Q Doc, Models)
propToBangType field :: Field
field@Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..} = do
        (Q Type
myType, (Q Doc
content, Models
dependencies)) <- Text
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a. Text -> Generator a -> Generator a
OAM.nested Text
fieldProp (Generator TypeWithDeclaration -> Generator TypeWithDeclaration)
-> Generator TypeWithDeclaration -> Generator TypeWithDeclaration
forall a b. (a -> b) -> a -> b
$ Text -> Schema -> Generator TypeWithDeclaration
defineModelForSchemaNamed (Text
fieldName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
propTypeSuffix) Schema
fieldSchema
        let myBang :: Q VarBangType
myBang = Field -> Q Type -> Q VarBangType
createBang Field
field Q Type
myType
        (Q VarBangType, Q Doc, Models)
-> Generator (Q VarBangType, Q Doc, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Q VarBangType
myBang, Q Doc
content, Models
dependencies)
      foldFn :: OAM.Generator BangTypesSelfDefined -> (Text, Field) -> OAM.Generator BangTypesSelfDefined
      foldFn :: Generator (Q [VarBangType], Q Doc, Models)
-> (Text, Field) -> Generator (Q [VarBangType], Q Doc, Models)
foldFn Generator (Q [VarBangType], Q Doc, Models)
accHolder (Text, Field)
next = do
        (Q [VarBangType]
varBang, Q Doc
content, Models
dependencies) <- Generator (Q [VarBangType], Q Doc, Models)
accHolder
        (Q VarBangType
nextVarBang, Q Doc
nextContent, Models
nextDependencies) <- Field -> Generator (Q VarBangType, Q Doc, Models)
propToBangType (Field -> Generator (Q VarBangType, Q Doc, Models))
-> Field -> Generator (Q VarBangType, Q Doc, Models)
forall a b. (a -> b) -> a -> b
$ (Text, Field) -> Field
forall a b. (a, b) -> b
snd (Text, Field)
next
        (Q [VarBangType], Q Doc, Models)
-> Generator (Q [VarBangType], Q Doc, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( Q [VarBangType]
varBang Q [VarBangType] -> Q [VarBangType] -> Q [VarBangType]
forall (f :: * -> *) a.
(Applicative f, Semigroup a) =>
f a -> f a -> f a
`liftedAppend` (VarBangType -> [VarBangType]) -> Q VarBangType -> Q [VarBangType]
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VarBangType -> [VarBangType]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure Q VarBangType
nextVarBang,
            Q Doc
content Q Doc -> Q Doc -> Q Doc
forall (f :: * -> *). Applicative f => f Doc -> f Doc -> f Doc
`appendDoc` Q Doc
nextContent,
            Models -> Models -> Models
forall a. Ord a => Set a -> Set a -> Set a
Set.union Models
dependencies Models
nextDependencies
          )
  (Generator (Q [VarBangType], Q Doc, Models)
 -> (Text, Field) -> Generator (Q [VarBangType], Q Doc, Models))
-> Generator (Q [VarBangType], Q Doc, Models)
-> [(Text, Field)]
-> Generator (Q [VarBangType], Q Doc, Models)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Generator (Q [VarBangType], Q Doc, Models)
-> (Text, Field) -> Generator (Q [VarBangType], Q Doc, Models)
foldFn ((Q [VarBangType], Q Doc, Models)
-> Generator (Q [VarBangType], Q Doc, Models)
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([VarBangType] -> Q [VarBangType]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [], Q Doc
forall (f :: * -> *). Applicative f => f Doc
emptyDoc, Models
forall a. Set a
Set.empty)) [(Text, Field)]
fieldProps

getDescriptionOfSchema :: OAS.SchemaObject -> Text
getDescriptionOfSchema :: SchemaObject -> Text
getDescriptionOfSchema SchemaObject
schema = Text -> Text
Doc.escapeText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ SchemaObject -> Maybe Text
OAS.schemaObjectDescription SchemaObject
schema

getDescriptionOfProperties :: [(Text, Field)] -> OAM.Generator [Text]
getDescriptionOfProperties :: [(Text, Field)] -> Generator [Text]
getDescriptionOfProperties =
  ((Text, Field) -> Generator Text)
-> [(Text, Field)] -> Generator [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
    ( \(Text
propName, Field {Bool
Name
Text
Schema
fieldProp :: Field -> Text
fieldName :: Field -> Text
fieldSchema :: Field -> Schema
fieldRequired :: Field -> Bool
fieldHaskellName :: Field -> Name
fieldProp :: Text
fieldName :: Text
fieldSchema :: Schema
fieldRequired :: Bool
fieldHaskellName :: Name
..}) -> do
        Maybe SchemaObject
schema' <- Schema -> Generator (Maybe SchemaObject)
resolveSchemaReferenceWithoutWarning Schema
fieldSchema
        let description :: Text
description = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema' Maybe SchemaObject -> (SchemaObject -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Text
OAS.schemaObjectDescription
            constraints :: Text
constraints = [Text] -> Text
T.unlines ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text
"* " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe SchemaObject -> [Text]
getConstraintDescriptionsOfSchema Maybe SchemaObject
schema'
        Text -> Generator Text
forall a. a -> Generator a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Generator Text) -> Text -> Generator Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Doc.escapeText (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
propName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
description Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Text -> Bool
T.null Text
constraints then Text
"" else Text
"\n\nConstraints:\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
constraints)
    )

-- | Extracts the constraints of a 'OAS.SchemaObject' as human readable text
getConstraintDescriptionsOfSchema :: Maybe OAS.SchemaObject -> [Text]
getConstraintDescriptionsOfSchema :: Maybe SchemaObject -> [Text]
getConstraintDescriptionsOfSchema Maybe SchemaObject
schema =
  let showConstraint :: Text -> f a -> f Text
showConstraint Text
desc = Text -> Text -> f a -> f Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> Text -> f a -> f Text
showConstraintSurrounding Text
desc Text
""
      showConstraintSurrounding :: Text -> Text -> f a -> f Text
showConstraintSurrounding Text
prev Text
after = (a -> Text) -> f a -> f Text
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Text) -> f a -> f Text) -> (a -> Text) -> f a -> f Text
forall a b. (a -> b) -> a -> b
$ (Text
prev Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
after) (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
      exclusiveMaximum :: Bool
exclusiveMaximum = Bool -> (SchemaObject -> Bool) -> Maybe SchemaObject -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SchemaObject -> Bool
OAS.schemaObjectExclusiveMaximum Maybe SchemaObject
schema
      exclusiveMinimum :: Bool
exclusiveMinimum = Bool -> (SchemaObject -> Bool) -> Maybe SchemaObject -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False SchemaObject -> Bool
OAS.schemaObjectExclusiveMinimum Maybe SchemaObject
schema
   in [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
Maybe.catMaybes
        [ Text -> Maybe Float -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> f a -> f Text
showConstraint Text
"Must be a multiple of " (Maybe Float -> Maybe Text) -> Maybe Float -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Float) -> Maybe Float
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Float
OAS.schemaObjectMultipleOf,
          Text -> Maybe Float -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> f a -> f Text
showConstraint (Text
"Maxium " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
exclusiveMaximum then Text
" (exclusive)" else Text
"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of ") (Maybe Float -> Maybe Text) -> Maybe Float -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Float) -> Maybe Float
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Float
OAS.schemaObjectMaximum,
          Text -> Maybe Float -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> f a -> f Text
showConstraint (Text
"Minimum " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Bool
exclusiveMinimum then Text
" (exclusive)" else Text
"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" of ") (Maybe Float -> Maybe Text) -> Maybe Float -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Float) -> Maybe Float
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Float
OAS.schemaObjectMinimum,
          Text -> Maybe Word -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> f a -> f Text
showConstraint Text
"Maximum length of " (Maybe Word -> Maybe Text) -> Maybe Word -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Word
OAS.schemaObjectMaxLength,
          Text -> Maybe Word -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> f a -> f Text
showConstraint Text
"Minimum length of " (Maybe Word -> Maybe Text) -> Maybe Word -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Word
OAS.schemaObjectMinLength,
          (Text
"Must match pattern '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'") (Text -> Text) -> Maybe Text -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Text
OAS.schemaObjectPattern),
          Text -> Text -> Maybe Word -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> Text -> f a -> f Text
showConstraintSurrounding Text
"Must have a maximum of " Text
" items" (Maybe Word -> Maybe Text) -> Maybe Word -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Word
OAS.schemaObjectMaxItems,
          Text -> Text -> Maybe Word -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> Text -> f a -> f Text
showConstraintSurrounding Text
"Must have a minimum of " Text
" items" (Maybe Word -> Maybe Text) -> Maybe Word -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Word
OAS.schemaObjectMinItems,
          Maybe SchemaObject
schema
            Maybe SchemaObject -> (SchemaObject -> Maybe Text) -> Maybe Text
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \case
                    Bool
True -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Must have unique items"
                    Bool
False -> Maybe Text
forall a. Maybe a
Nothing
                )
              (Bool -> Maybe Text)
-> (SchemaObject -> Bool) -> SchemaObject -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SchemaObject -> Bool
OAS.schemaObjectUniqueItems,
          Text -> Text -> Maybe Word -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> Text -> f a -> f Text
showConstraintSurrounding Text
"Must have a maximum of " Text
" properties" (Maybe Word -> Maybe Text) -> Maybe Word -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Word
OAS.schemaObjectMaxProperties,
          Text -> Text -> Maybe Word -> Maybe Text
forall {f :: * -> *} {a}.
(Functor f, Show a) =>
Text -> Text -> f a -> f Text
showConstraintSurrounding Text
"Must have a minimum of " Text
" properties" (Maybe Word -> Maybe Text) -> Maybe Word -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Maybe SchemaObject
schema Maybe SchemaObject -> (SchemaObject -> Maybe Word) -> Maybe Word
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SchemaObject -> Maybe Word
OAS.schemaObjectMinProperties
        ]

-- | Extracts the 'Name' of a 'OAS.SchemaObject' which should be used for primitive types
getSchemaType :: OAO.Settings -> OAS.SchemaObject -> Name
getSchemaType :: Settings -> SchemaObject -> Name
getSchemaType OAO.Settings {settingUseIntWithArbitraryPrecision :: Settings -> Bool
settingUseIntWithArbitraryPrecision = Bool
True} OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeInteger} = ''Integer
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeInteger, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"int32"} = ''Int.Int32
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeInteger, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"int64"} = ''Int.Int64
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeInteger} = ''Int
getSchemaType OAO.Settings {settingUseFloatWithArbitraryPrecision :: Settings -> Bool
settingUseFloatWithArbitraryPrecision = Bool
True} OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeNumber} = ''Scientific.Scientific
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeNumber, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"float"} = ''Float
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeNumber, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"double"} = ''Double
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeNumber} = ''Double
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeString, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"byte"} = ''OC.JsonByteString
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeString, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"binary"} = ''OC.JsonByteString
getSchemaType OAO.Settings {settingUseDateTypesAsString :: Settings -> Bool
settingUseDateTypesAsString = Bool
True} OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeString, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"date"} = ''Day
getSchemaType OAO.Settings {settingUseDateTypesAsString :: Settings -> Bool
settingUseDateTypesAsString = Bool
True} OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeString, schemaObjectFormat :: SchemaObject -> Maybe Text
schemaObjectFormat = Just Text
"date-time"} = ''OC.JsonDateTime
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeString} = ''Text
getSchemaType Settings
_ OAS.SchemaObject {schemaObjectType :: SchemaObject -> SchemaType
schemaObjectType = SchemaType
OAS.SchemaTypeBool} = ''Bool
getSchemaType Settings
_ OAS.SchemaObject {} = ''Text

getCurrentPathEscaped :: OAM.Generator Text
getCurrentPathEscaped :: Generator Text
getCurrentPathEscaped = Text -> Text
Doc.escapeText (Text -> Text) -> ([Text] -> Text) -> [Text] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"." ([Text] -> Text) -> Generator [Text] -> Generator Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Generator [Text]
OAM.getCurrentPath