{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

-- | This module defines the settings and their default values.
module OpenAPI.Generate.OptParse
  ( Settings (..),
    getSettings,
    module OAT,
  )
where

import Autodocodec.Yaml
import Control.Applicative
import Control.Monad
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified OpenAPI.Generate.Log as OAL
import OpenAPI.Generate.OptParse.Configuration
import OpenAPI.Generate.OptParse.Flags
import OpenAPI.Generate.OptParse.Types as OAT
import Options.Applicative
import Path
import Path.IO
import System.Exit

getSettings :: IO Settings
getSettings :: IO Settings
getSettings = do
  Flags
flags <- IO Flags
getFlags
  let configurationFilePath :: Text
configurationFilePath = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"openapi-configuration.yml" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Flags -> Maybe Text
flagConfiguration Flags
flags
  Maybe Configuration
config <- Text -> IO (Maybe Configuration)
getConfiguration Text
configurationFilePath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Maybe Configuration -> Bool
forall a. Maybe a -> Bool
isJust Maybe Configuration
config Bool -> Bool -> Bool
|| Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing (Flags -> Maybe Text
flagConfiguration Flags
flags)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. String -> IO a
die (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Could not read configuration file: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
configurationFilePath
  Flags -> Maybe Configuration -> Text -> IO Settings
combineToSettings Flags
flags Maybe Configuration
config Text
configurationFilePath

data Settings = Settings
  { -- | The OpenAPI 3 specification file which code should be generated for.
    Settings -> Text
settingOpenApiSpecification :: !Text,
    -- | The directory where the generated output is stored.
    Settings -> Text
settingOutputDir :: !Text,
    -- | Name of the stack project
    Settings -> Text
settingPackageName :: !Text,
    -- | Name of the module
    Settings -> ModuleName
settingModuleName :: !ModuleName,
    -- | The minimum log level to output
    Settings -> LogSeverity
settingLogLevel :: !OAL.LogSeverity,
    -- | Overwrite output directory without question
    Settings -> Bool
settingForce :: !Bool,
    -- | Only write new/changed files
    Settings -> Bool
settingIncremental :: !Bool,
    -- | Do not generate the output files but only print the generated code
    Settings -> Bool
settingDryRun :: !Bool,
    -- | Do not generate a stack project alongside the raw Haskell files
    Settings -> Bool
settingDoNotGenerateStackProject :: !Bool,
    -- | Generate Nix files (default.nix and shell.nix)
    Settings -> Bool
settingGenerateNixFiles :: !Bool,
    -- | Omit the additional operation functions, which are: with explicit configuration and raw variants (returning the plain ByteString) for both with and without explicit configuration
    Settings -> Bool
settingOmitAdditionalOperationFunctions :: !Bool,
    -- | Force the generator to create types for empty request bodies which are optional (e. g. no properties and required equals false)
    Settings -> Bool
settingGenerateOptionalEmptyRequestBody :: !Bool,
    -- | Use numbered data constructors (e. g. Variant1, Variant 2, etc.) for one-of types
    Settings -> Bool
settingUseNumberedVariantConstructors :: !Bool,
    -- | Use Data.Scientific instead of Double to support arbitrary number precision
    Settings -> Bool
settingUseFloatWithArbitraryPrecision :: !Bool,
    -- | Use 'Integer' instead of 'Int' to support arbitrary number precision
    Settings -> Bool
settingUseIntWithArbitraryPrecision :: !Bool,
    -- | Convert strings formatted as date / date-time to date types
    Settings -> Bool
settingUseDateTypesAsString :: !Bool,
    -- | Convert names to CamelCase instead of using names which are as close as possible to the names provided in the specification
    Settings -> Bool
settingConvertToCamelCase :: !Bool,
    -- | Add a suffix to property types to prevent naming conflicts
    Settings -> Text
settingPropertyTypeSuffix :: !Text,
    -- | The suffix which is added to the response data types
    Settings -> Text
settingResponseTypeSuffix :: !Text,
    -- | The suffix which is added to the response body data types
    Settings -> Text
settingResponseBodyTypeSuffix :: !Text,
    -- | The suffix which is added to the request body data types
    Settings -> Text
settingRequestBodyTypeSuffix :: !Text,
    -- | The suffix which is added to the item type of an array. This is only applied to item types of top level array types which an alias is generated for.
    Settings -> Text
settingArrayItemTypeSuffix :: !Text,
    -- | The suffix which is added to the non-nullable part of a nullable type. This is only applied to top level nullable schemas as they are the only ones which need to be referencable by name.
    Settings -> Text
settingNonNullableTypeSuffix :: !Text,
    -- | The suffix which is added to the parameters type of operations
    Settings -> Text
settingParametersTypeSuffix :: !Text,
    -- | The prefix which is added to query parameters
    Settings -> Text
settingParameterQueryPrefix :: !Text,
    -- | The prefix which is added to path parameters
    Settings -> Text
settingParameterPathPrefix :: !Text,
    -- | The prefix which is added to cookie parameters
    Settings -> Text
settingParameterCookiePrefix :: !Text,
    -- | The prefix which is added to header parameters
    Settings -> Text
settingParameterHeaderPrefix :: !Text,
    -- | The operations to generate (if empty all operations are generated)
    Settings -> [Text]
settingOperationsToGenerate :: ![Text],
    -- | A list of schema names (exactly as they are named in the components.schemas section of the corresponding OpenAPI 3 specification)
    -- which are not further investigated while generating code from the specification.
    -- Only a type alias to 'Aeson.Value' is created for these schemas.
    Settings -> [Text]
settingOpaqueSchemas :: ![Text],
    -- | A list of schema names (exactly as they are named in the components.schemas section of the corresponding OpenAPI 3 specification)
    -- which need to be generated.
    -- For all other schemas only a type alias to 'Aeson.Value' is created.
    Settings -> [Text]
settingWhiteListedSchemas :: ![Text],
    -- | Output all schemas.
    Settings -> Bool
settingOutputAllSchemas :: !Bool,
    -- | In OpenAPI 3, fixed values can be defined as an enum with only one allowed value.
    -- If such a constant value is encountered as a required property of an object,
    -- the generator excludes this property by default ("exclude" strategy) and
    -- adds the value in the 'ToJSON' instance and expects the value to be there
    -- in the 'FromJSON' instance.
    -- This setting allows to change this behavior by including all fixed value
    -- fields instead ("include" strategy), i.e. just not trying to do anything smart.
    Settings -> FixedValueStrategy
settingFixedValueStrategy :: !FixedValueStrategy,
    -- | When encountering an object with a single field, shorten the field of that object to be the
    -- schema name. Respects property type suffix.
    Settings -> Bool
settingShortenSingleFieldObjects :: !Bool
  }
  deriving (Int -> Settings -> String -> String
[Settings] -> String -> String
Settings -> String
(Int -> Settings -> String -> String)
-> (Settings -> String)
-> ([Settings] -> String -> String)
-> Show Settings
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Settings -> String -> String
showsPrec :: Int -> Settings -> String -> String
$cshow :: Settings -> String
show :: Settings -> String
$cshowList :: [Settings] -> String -> String
showList :: [Settings] -> String -> String
Show, Settings -> Settings -> Bool
(Settings -> Settings -> Bool)
-> (Settings -> Settings -> Bool) -> Eq Settings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Settings -> Settings -> Bool
== :: Settings -> Settings -> Bool
$c/= :: Settings -> Settings -> Bool
/= :: Settings -> Settings -> Bool
Eq)

combineToSettings :: Flags -> Maybe Configuration -> Text -> IO Settings
combineToSettings :: Flags -> Maybe Configuration -> Text -> IO Settings
combineToSettings Flags {Maybe Bool
Maybe [Text]
Maybe Text
Maybe LogSeverity
Maybe FixedValueStrategy
flagConfiguration :: Flags -> Maybe Text
flagConfiguration :: Maybe Text
flagOpenApiSpecification :: Maybe Text
flagOutputDir :: Maybe Text
flagPackageName :: Maybe Text
flagModuleName :: Maybe Text
flagLogLevel :: Maybe LogSeverity
flagForce :: Maybe Bool
flagIncremental :: Maybe Bool
flagDryRun :: Maybe Bool
flagDoNotGenerateStackProject :: Maybe Bool
flagGenerateNixFiles :: Maybe Bool
flagOmitAdditionalOperationFunctions :: Maybe Bool
flagGenerateOptionalEmptyRequestBody :: Maybe Bool
flagUseNumberedVariantConstructors :: Maybe Bool
flagUseFloatWithArbitraryPrecision :: Maybe Bool
flagUseIntWithArbitraryPrecision :: Maybe Bool
flagUseDateTypesAsString :: Maybe Bool
flagConvertToCamelCase :: Maybe Bool
flagPropertyTypeSuffix :: Maybe Text
flagResponseTypeSuffix :: Maybe Text
flagResponseBodyTypeSuffix :: Maybe Text
flagRequestBodyTypeSuffix :: Maybe Text
flagArrayItemTypeSuffix :: Maybe Text
flagNonNullableTypeSuffix :: Maybe Text
flagParametersTypeSuffix :: Maybe Text
flagParameterQueryPrefix :: Maybe Text
flagParameterPathPrefix :: Maybe Text
flagParameterCookiePrefix :: Maybe Text
flagParameterHeaderPrefix :: Maybe Text
flagOperationsToGenerate :: Maybe [Text]
flagOpaqueSchemas :: Maybe [Text]
flagWhiteListedSchemas :: Maybe [Text]
flagOutputAllSchemas :: Maybe Bool
flagFixedValueStrategy :: Maybe FixedValueStrategy
flagShortenSingleFieldObjects :: Maybe Bool
flagOpenApiSpecification :: Flags -> Maybe Text
flagOutputDir :: Flags -> Maybe Text
flagPackageName :: Flags -> Maybe Text
flagModuleName :: Flags -> Maybe Text
flagLogLevel :: Flags -> Maybe LogSeverity
flagForce :: Flags -> Maybe Bool
flagIncremental :: Flags -> Maybe Bool
flagDryRun :: Flags -> Maybe Bool
flagDoNotGenerateStackProject :: Flags -> Maybe Bool
flagGenerateNixFiles :: Flags -> Maybe Bool
flagOmitAdditionalOperationFunctions :: Flags -> Maybe Bool
flagGenerateOptionalEmptyRequestBody :: Flags -> Maybe Bool
flagUseNumberedVariantConstructors :: Flags -> Maybe Bool
flagUseFloatWithArbitraryPrecision :: Flags -> Maybe Bool
flagUseIntWithArbitraryPrecision :: Flags -> Maybe Bool
flagUseDateTypesAsString :: Flags -> Maybe Bool
flagConvertToCamelCase :: Flags -> Maybe Bool
flagPropertyTypeSuffix :: Flags -> Maybe Text
flagResponseTypeSuffix :: Flags -> Maybe Text
flagResponseBodyTypeSuffix :: Flags -> Maybe Text
flagRequestBodyTypeSuffix :: Flags -> Maybe Text
flagArrayItemTypeSuffix :: Flags -> Maybe Text
flagNonNullableTypeSuffix :: Flags -> Maybe Text
flagParametersTypeSuffix :: Flags -> Maybe Text
flagParameterQueryPrefix :: Flags -> Maybe Text
flagParameterPathPrefix :: Flags -> Maybe Text
flagParameterCookiePrefix :: Flags -> Maybe Text
flagParameterHeaderPrefix :: Flags -> Maybe Text
flagOperationsToGenerate :: Flags -> Maybe [Text]
flagOpaqueSchemas :: Flags -> Maybe [Text]
flagWhiteListedSchemas :: Flags -> Maybe [Text]
flagOutputAllSchemas :: Flags -> Maybe Bool
flagFixedValueStrategy :: Flags -> Maybe FixedValueStrategy
flagShortenSingleFieldObjects :: Flags -> Maybe Bool
..} Maybe Configuration
mConf Text
configurationFilePath = do
  let resolveRelativeToConfiguration :: Maybe Text -> IO (Maybe Text)
resolveRelativeToConfiguration = \case
        Just Text
filePath -> do
          Path Abs File
configurationDirectory <- String -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' (String -> IO (Path Abs File)) -> String -> IO (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
configurationFilePath
          Path Abs File
file <- Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile (Path Abs File -> Path Abs Dir
forall b t. Path b t -> Path b Dir
parent Path Abs File
configurationDirectory) (String -> IO (Path Abs File)) -> String -> IO (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
filePath
          Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
file
        Maybe Text
_ -> Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing
  Maybe Text
mConfigOpenApiSpecification <- Maybe Text -> IO (Maybe Text)
resolveRelativeToConfiguration (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configOpenApiSpecification
  Maybe Text
mConfigOutputDir <- Maybe Text -> IO (Maybe Text)
resolveRelativeToConfiguration (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configOutputDir
  let settingOpenApiSpecification :: Text
settingOpenApiSpecification = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"openapi-specification.yml" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagOpenApiSpecification Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
mConfigOpenApiSpecification
      settingOutputDir :: Text
settingOutputDir = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"out" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagOutputDir Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text
mConfigOutputDir
      settingPackageName :: Text
settingPackageName = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"openapi" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagPackageName Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configPackageName
      settingModuleName :: ModuleName
settingModuleName = String -> ModuleName
mkModuleName (String -> ModuleName) -> (Text -> String) -> Text -> ModuleName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ModuleName) -> Text -> ModuleName
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"OpenAPI" (Maybe Text
flagModuleName Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configModuleName)
      settingLogLevel :: LogSeverity
settingLogLevel = LogSeverity -> Maybe LogSeverity -> LogSeverity
forall a. a -> Maybe a -> a
fromMaybe LogSeverity
OAL.InfoSeverity (Maybe LogSeverity -> LogSeverity)
-> Maybe LogSeverity -> LogSeverity
forall a b. (a -> b) -> a -> b
$ Maybe LogSeverity
flagLogLevel Maybe LogSeverity -> Maybe LogSeverity -> Maybe LogSeverity
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe LogSeverity) -> Maybe LogSeverity
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe LogSeverity
configLogLevel
      settingForce :: Bool
settingForce = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagForce Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configForce
      settingIncremental :: Bool
settingIncremental = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagIncremental Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configIncremental
      settingDryRun :: Bool
settingDryRun = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagDryRun Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configDryRun
      settingDoNotGenerateStackProject :: Bool
settingDoNotGenerateStackProject = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagDoNotGenerateStackProject Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configDoNotGenerateStackProject
      settingGenerateNixFiles :: Bool
settingGenerateNixFiles = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagGenerateNixFiles Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configGenerateNixFiles
      settingOmitAdditionalOperationFunctions :: Bool
settingOmitAdditionalOperationFunctions = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagOmitAdditionalOperationFunctions Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configOmitAdditionalOperationFunctions
      settingGenerateOptionalEmptyRequestBody :: Bool
settingGenerateOptionalEmptyRequestBody = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagGenerateOptionalEmptyRequestBody Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configGenerateOptionalEmptyRequestBody
      settingUseNumberedVariantConstructors :: Bool
settingUseNumberedVariantConstructors = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagUseNumberedVariantConstructors Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configUseNumberedVariantConstructors
      settingUseFloatWithArbitraryPrecision :: Bool
settingUseFloatWithArbitraryPrecision = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagUseFloatWithArbitraryPrecision Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configUseFloatWithArbitraryPrecision
      settingUseIntWithArbitraryPrecision :: Bool
settingUseIntWithArbitraryPrecision = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagUseIntWithArbitraryPrecision Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configUseIntWithArbitraryPrecision
      settingUseDateTypesAsString :: Bool
settingUseDateTypesAsString = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagUseDateTypesAsString Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configUseDateTypesAsString
      settingConvertToCamelCase :: Bool
settingConvertToCamelCase = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagConvertToCamelCase Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configConvertToCamelCase
      settingPropertyTypeSuffix :: Text
settingPropertyTypeSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagPropertyTypeSuffix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configPropertyTypeSuffix
      settingResponseTypeSuffix :: Text
settingResponseTypeSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Response" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagResponseTypeSuffix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configResponseTypeSuffix
      settingResponseBodyTypeSuffix :: Text
settingResponseBodyTypeSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"ResponseBody" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagResponseBodyTypeSuffix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configResponseBodyTypeSuffix
      settingRequestBodyTypeSuffix :: Text
settingRequestBodyTypeSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"RequestBody" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagRequestBodyTypeSuffix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configRequestBodyTypeSuffix
      settingArrayItemTypeSuffix :: Text
settingArrayItemTypeSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Item" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagArrayItemTypeSuffix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configArrayItemTypeSuffix
      settingNonNullableTypeSuffix :: Text
settingNonNullableTypeSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"NonNullable" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagNonNullableTypeSuffix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configNonNullableTypeSuffix
      settingParametersTypeSuffix :: Text
settingParametersTypeSuffix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"Parameters" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagParametersTypeSuffix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configParametersTypeSuffix
      settingParameterQueryPrefix :: Text
settingParameterQueryPrefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"query" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagParameterQueryPrefix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configParameterQueryPrefix
      settingParameterPathPrefix :: Text
settingParameterPathPrefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"path" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagParameterPathPrefix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configParameterPathPrefix
      settingParameterCookiePrefix :: Text
settingParameterCookiePrefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"cookie" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagParameterCookiePrefix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configParameterCookiePrefix
      settingParameterHeaderPrefix :: Text
settingParameterHeaderPrefix = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"header" (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Maybe Text
flagParameterHeaderPrefix Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Text) -> Maybe Text
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Text
configParameterHeaderPrefix
      settingOperationsToGenerate :: [Text]
settingOperationsToGenerate = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe [Text]
flagOperationsToGenerate Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe [Text]) -> Maybe [Text]
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe [Text]
configOperationsToGenerate
      settingOpaqueSchemas :: [Text]
settingOpaqueSchemas = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe [Text]
flagOpaqueSchemas Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe [Text]) -> Maybe [Text]
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe [Text]
configOpaqueSchemas
      settingWhiteListedSchemas :: [Text]
settingWhiteListedSchemas = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Text] -> [Text]) -> Maybe [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Maybe [Text]
flagWhiteListedSchemas Maybe [Text] -> Maybe [Text] -> Maybe [Text]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe [Text]) -> Maybe [Text]
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe [Text]
configWhiteListedSchemas
      settingOutputAllSchemas :: Bool
settingOutputAllSchemas = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagOutputAllSchemas Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configOutputAllSchemas
      settingFixedValueStrategy :: FixedValueStrategy
settingFixedValueStrategy = FixedValueStrategy
-> Maybe FixedValueStrategy -> FixedValueStrategy
forall a. a -> Maybe a -> a
fromMaybe FixedValueStrategy
FixedValueStrategyExclude (Maybe FixedValueStrategy -> FixedValueStrategy)
-> Maybe FixedValueStrategy -> FixedValueStrategy
forall a b. (a -> b) -> a -> b
$ Maybe FixedValueStrategy
flagFixedValueStrategy Maybe FixedValueStrategy
-> Maybe FixedValueStrategy -> Maybe FixedValueStrategy
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe FixedValueStrategy)
-> Maybe FixedValueStrategy
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe FixedValueStrategy
configFixedValueStrategy
      settingShortenSingleFieldObjects :: Bool
settingShortenSingleFieldObjects = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool) -> Maybe Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Maybe Bool
flagShortenSingleFieldObjects Maybe Bool -> Maybe Bool -> Maybe Bool
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Configuration -> Maybe Bool) -> Maybe Bool
forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe Bool
configShortenSingleFieldObjects

  Settings -> IO Settings
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Settings {Bool
[Text]
Text
LogSeverity
FixedValueStrategy
ModuleName
settingOpenApiSpecification :: Text
settingOutputDir :: Text
settingPackageName :: Text
settingModuleName :: ModuleName
settingLogLevel :: LogSeverity
settingForce :: Bool
settingIncremental :: Bool
settingDryRun :: Bool
settingDoNotGenerateStackProject :: Bool
settingGenerateNixFiles :: Bool
settingOmitAdditionalOperationFunctions :: Bool
settingGenerateOptionalEmptyRequestBody :: Bool
settingUseNumberedVariantConstructors :: Bool
settingUseFloatWithArbitraryPrecision :: Bool
settingUseIntWithArbitraryPrecision :: Bool
settingUseDateTypesAsString :: Bool
settingConvertToCamelCase :: Bool
settingPropertyTypeSuffix :: Text
settingResponseTypeSuffix :: Text
settingResponseBodyTypeSuffix :: Text
settingRequestBodyTypeSuffix :: Text
settingArrayItemTypeSuffix :: Text
settingNonNullableTypeSuffix :: Text
settingParametersTypeSuffix :: Text
settingParameterQueryPrefix :: Text
settingParameterPathPrefix :: Text
settingParameterCookiePrefix :: Text
settingParameterHeaderPrefix :: Text
settingOperationsToGenerate :: [Text]
settingOpaqueSchemas :: [Text]
settingWhiteListedSchemas :: [Text]
settingOutputAllSchemas :: Bool
settingFixedValueStrategy :: FixedValueStrategy
settingShortenSingleFieldObjects :: Bool
settingOpenApiSpecification :: Text
settingOutputDir :: Text
settingPackageName :: Text
settingModuleName :: ModuleName
settingLogLevel :: LogSeverity
settingForce :: Bool
settingIncremental :: Bool
settingDryRun :: Bool
settingDoNotGenerateStackProject :: Bool
settingGenerateNixFiles :: Bool
settingOmitAdditionalOperationFunctions :: Bool
settingGenerateOptionalEmptyRequestBody :: Bool
settingUseNumberedVariantConstructors :: Bool
settingUseFloatWithArbitraryPrecision :: Bool
settingUseIntWithArbitraryPrecision :: Bool
settingUseDateTypesAsString :: Bool
settingConvertToCamelCase :: Bool
settingPropertyTypeSuffix :: Text
settingResponseTypeSuffix :: Text
settingResponseBodyTypeSuffix :: Text
settingRequestBodyTypeSuffix :: Text
settingArrayItemTypeSuffix :: Text
settingNonNullableTypeSuffix :: Text
settingParametersTypeSuffix :: Text
settingParameterQueryPrefix :: Text
settingParameterPathPrefix :: Text
settingParameterCookiePrefix :: Text
settingParameterHeaderPrefix :: Text
settingOperationsToGenerate :: [Text]
settingOpaqueSchemas :: [Text]
settingWhiteListedSchemas :: [Text]
settingOutputAllSchemas :: Bool
settingFixedValueStrategy :: FixedValueStrategy
settingShortenSingleFieldObjects :: Bool
..}
  where
    mc :: (Configuration -> Maybe a) -> Maybe a
    mc :: forall a. (Configuration -> Maybe a) -> Maybe a
mc Configuration -> Maybe a
f = Maybe Configuration
mConf Maybe Configuration -> (Configuration -> Maybe a) -> Maybe a
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Configuration -> Maybe a
f

getFlags :: IO Flags
getFlags :: IO Flags
getFlags = ParserPrefs -> ParserInfo Flags -> IO Flags
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
prefs_ ParserInfo Flags
flagsParser

prefs_ :: ParserPrefs
prefs_ :: ParserPrefs
prefs_ =
  ParserPrefs
defaultPrefs
    { prefShowHelpOnError = True,
      prefShowHelpOnEmpty = True
    }

flagsParser :: ParserInfo Flags
flagsParser :: ParserInfo Flags
flagsParser =
  Parser Flags -> InfoMod Flags -> ParserInfo Flags
forall a. Parser a -> InfoMod a -> ParserInfo a
info
    (Parser (Flags -> Flags)
forall a. Parser (a -> a)
helper Parser (Flags -> Flags) -> Parser Flags -> Parser Flags
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Flags
parseFlags)
    ( InfoMod Flags
forall a. InfoMod a
fullDesc
        InfoMod Flags -> InfoMod Flags -> InfoMod Flags
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Flags
forall a. String -> InfoMod a
footer String
footerStr
        InfoMod Flags -> InfoMod Flags -> InfoMod Flags
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Flags
forall a. String -> InfoMod a
progDesc String
"This tool can be used to generate Haskell code from OpenAPI 3 specifications. For more information see https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator."
        InfoMod Flags -> InfoMod Flags -> InfoMod Flags
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod Flags
forall a. String -> InfoMod a
header String
"Generate Haskell code from OpenAPI 3 specifications"
    )
  where
    footerStr :: String
footerStr =
      [String] -> String
unlines
        [ String
"Configuration file format:",
          String
"",
          Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ forall a. HasCodec a => Text
renderColouredSchemaViaCodec @Configuration
        ]