{-
   httpstan

   No description provided (generated by Openapi Generator https://github.com/openapitools/openapi-generator)

   OpenAPI Version: 3.0.1
   httpstan API version: 4.10.0
   Generated by OpenAPI Generator (https://openapi-generator.tech)
-}

{-|
Module : Httpstan.Model
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}

module Httpstan.Model where

import Httpstan.Core
import Httpstan.MimeTypes

import Data.Aeson ((.:),(.:!),(.:?),(.=))

import qualified Control.Arrow as P (left)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as BL
import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)
import qualified Data.Foldable as P
import qualified Data.HashMap.Lazy as HM
import qualified Data.Map as Map
import qualified Data.Maybe as P
import qualified Data.Set as Set
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Time as TI
import qualified Lens.Micro as L
import qualified Web.FormUrlEncoded as WH
import qualified Web.HttpApiData as WH

import Control.Applicative ((<|>))
import Control.Applicative (Alternative)
import Data.Function ((&))
import Data.Monoid ((<>))
import Data.Text (Text)
import Prelude (($),(/=),(.),(<$>),(<*>),(>>=),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)

import qualified Prelude as P



-- * Parameter newtypes


-- ** AdjustTransform
newtype AdjustTransform = AdjustTransform { AdjustTransform -> Bool
unAdjustTransform :: Bool } deriving (AdjustTransform -> AdjustTransform -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AdjustTransform -> AdjustTransform -> Bool
$c/= :: AdjustTransform -> AdjustTransform -> Bool
== :: AdjustTransform -> AdjustTransform -> Bool
$c== :: AdjustTransform -> AdjustTransform -> Bool
P.Eq, Int -> AdjustTransform -> ShowS
[AdjustTransform] -> ShowS
AdjustTransform -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [AdjustTransform] -> ShowS
$cshowList :: [AdjustTransform] -> ShowS
show :: AdjustTransform -> [Char]
$cshow :: AdjustTransform -> [Char]
showsPrec :: Int -> AdjustTransform -> ShowS
$cshowsPrec :: Int -> AdjustTransform -> ShowS
P.Show, [AdjustTransform] -> Value
[AdjustTransform] -> Encoding
AdjustTransform -> Value
AdjustTransform -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [AdjustTransform] -> Encoding
$ctoEncodingList :: [AdjustTransform] -> Encoding
toJSONList :: [AdjustTransform] -> Value
$ctoJSONList :: [AdjustTransform] -> Value
toEncoding :: AdjustTransform -> Encoding
$ctoEncoding :: AdjustTransform -> Encoding
toJSON :: AdjustTransform -> Value
$ctoJSON :: AdjustTransform -> Value
A.ToJSON)

-- ** ConstrainedParameters
newtype ConstrainedParameters = ConstrainedParameters { ConstrainedParameters -> Value
unConstrainedParameters :: A.Value } deriving (ConstrainedParameters -> ConstrainedParameters -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConstrainedParameters -> ConstrainedParameters -> Bool
$c/= :: ConstrainedParameters -> ConstrainedParameters -> Bool
== :: ConstrainedParameters -> ConstrainedParameters -> Bool
$c== :: ConstrainedParameters -> ConstrainedParameters -> Bool
P.Eq, Int -> ConstrainedParameters -> ShowS
[ConstrainedParameters] -> ShowS
ConstrainedParameters -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConstrainedParameters] -> ShowS
$cshowList :: [ConstrainedParameters] -> ShowS
show :: ConstrainedParameters -> [Char]
$cshow :: ConstrainedParameters -> [Char]
showsPrec :: Int -> ConstrainedParameters -> ShowS
$cshowsPrec :: Int -> ConstrainedParameters -> ShowS
P.Show, [ConstrainedParameters] -> Value
[ConstrainedParameters] -> Encoding
ConstrainedParameters -> Value
ConstrainedParameters -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ConstrainedParameters] -> Encoding
$ctoEncodingList :: [ConstrainedParameters] -> Encoding
toJSONList :: [ConstrainedParameters] -> Value
$ctoJSONList :: [ConstrainedParameters] -> Value
toEncoding :: ConstrainedParameters -> Encoding
$ctoEncoding :: ConstrainedParameters -> Encoding
toJSON :: ConstrainedParameters -> Value
$ctoJSON :: ConstrainedParameters -> Value
A.ToJSON)

-- ** FitId
newtype FitId = FitId { FitId -> Text
unFitId :: Text } deriving (FitId -> FitId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FitId -> FitId -> Bool
$c/= :: FitId -> FitId -> Bool
== :: FitId -> FitId -> Bool
$c== :: FitId -> FitId -> Bool
P.Eq, Int -> FitId -> ShowS
[FitId] -> ShowS
FitId -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FitId] -> ShowS
$cshowList :: [FitId] -> ShowS
show :: FitId -> [Char]
$cshow :: FitId -> [Char]
showsPrec :: Int -> FitId -> ShowS
$cshowsPrec :: Int -> FitId -> ShowS
P.Show)

-- ** IncludeGqs
newtype IncludeGqs = IncludeGqs { IncludeGqs -> Bool
unIncludeGqs :: Bool } deriving (IncludeGqs -> IncludeGqs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IncludeGqs -> IncludeGqs -> Bool
$c/= :: IncludeGqs -> IncludeGqs -> Bool
== :: IncludeGqs -> IncludeGqs -> Bool
$c== :: IncludeGqs -> IncludeGqs -> Bool
P.Eq, Int -> IncludeGqs -> ShowS
[IncludeGqs] -> ShowS
IncludeGqs -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IncludeGqs] -> ShowS
$cshowList :: [IncludeGqs] -> ShowS
show :: IncludeGqs -> [Char]
$cshow :: IncludeGqs -> [Char]
showsPrec :: Int -> IncludeGqs -> ShowS
$cshowsPrec :: Int -> IncludeGqs -> ShowS
P.Show, [IncludeGqs] -> Value
[IncludeGqs] -> Encoding
IncludeGqs -> Value
IncludeGqs -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [IncludeGqs] -> Encoding
$ctoEncodingList :: [IncludeGqs] -> Encoding
toJSONList :: [IncludeGqs] -> Value
$ctoJSONList :: [IncludeGqs] -> Value
toEncoding :: IncludeGqs -> Encoding
$ctoEncoding :: IncludeGqs -> Encoding
toJSON :: IncludeGqs -> Value
$ctoJSON :: IncludeGqs -> Value
A.ToJSON)

-- ** ModelId
newtype ModelId = ModelId { ModelId -> Text
unModelId :: Text } deriving (ModelId -> ModelId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelId -> ModelId -> Bool
$c/= :: ModelId -> ModelId -> Bool
== :: ModelId -> ModelId -> Bool
$c== :: ModelId -> ModelId -> Bool
P.Eq, Int -> ModelId -> ShowS
[ModelId] -> ShowS
ModelId -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ModelId] -> ShowS
$cshowList :: [ModelId] -> ShowS
show :: ModelId -> [Char]
$cshow :: ModelId -> [Char]
showsPrec :: Int -> ModelId -> ShowS
$cshowsPrec :: Int -> ModelId -> ShowS
P.Show)

-- ** OperationId
newtype OperationId = OperationId { OperationId -> Text
unOperationId :: Text } deriving (OperationId -> OperationId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperationId -> OperationId -> Bool
$c/= :: OperationId -> OperationId -> Bool
== :: OperationId -> OperationId -> Bool
$c== :: OperationId -> OperationId -> Bool
P.Eq, Int -> OperationId -> ShowS
[OperationId] -> ShowS
OperationId -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [OperationId] -> ShowS
$cshowList :: [OperationId] -> ShowS
show :: OperationId -> [Char]
$cshow :: OperationId -> [Char]
showsPrec :: Int -> OperationId -> ShowS
$cshowsPrec :: Int -> OperationId -> ShowS
P.Show)

-- ** ParamData
newtype ParamData = ParamData { ParamData -> Value
unParamData :: A.Value } deriving (ParamData -> ParamData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParamData -> ParamData -> Bool
$c/= :: ParamData -> ParamData -> Bool
== :: ParamData -> ParamData -> Bool
$c== :: ParamData -> ParamData -> Bool
P.Eq, Int -> ParamData -> ShowS
[ParamData] -> ShowS
ParamData -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ParamData] -> ShowS
$cshowList :: [ParamData] -> ShowS
show :: ParamData -> [Char]
$cshow :: ParamData -> [Char]
showsPrec :: Int -> ParamData -> ShowS
$cshowsPrec :: Int -> ParamData -> ShowS
P.Show, [ParamData] -> Value
[ParamData] -> Encoding
ParamData -> Value
ParamData -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ParamData] -> Encoding
$ctoEncodingList :: [ParamData] -> Encoding
toJSONList :: [ParamData] -> Value
$ctoJSONList :: [ParamData] -> Value
toEncoding :: ParamData -> Encoding
$ctoEncoding :: ParamData -> Encoding
toJSON :: ParamData -> Value
$ctoJSON :: ParamData -> Value
A.ToJSON)

-- * Models


-- ** CreateFitRequest
-- | CreateFitRequest
data CreateFitRequest = CreateFitRequest
  { CreateFitRequest -> Maybe Int
createFitRequestChain :: !(Maybe Int) -- ^ "chain"
  , CreateFitRequest -> Maybe Value
createFitRequestData :: !(Maybe A.Value) -- ^ "data"
  , CreateFitRequest -> Maybe Double
createFitRequestDelta :: !(Maybe Double) -- ^ "delta"
  , CreateFitRequest -> E'Function
createFitRequestFunction :: !(E'Function) -- ^ /Required/ "function"
  , CreateFitRequest -> Maybe Double
createFitRequestGamma :: !(Maybe Double) -- ^ "gamma"
  , CreateFitRequest -> Maybe Value
createFitRequestInit :: !(Maybe A.Value) -- ^ "init"
  , CreateFitRequest -> Maybe Int
createFitRequestInitBuffer :: !(Maybe Int) -- ^ "init_buffer"
  , CreateFitRequest -> Maybe Double
createFitRequestInitRadius :: !(Maybe Double) -- ^ "init_radius"
  , CreateFitRequest -> Maybe Double
createFitRequestKappa :: !(Maybe Double) -- ^ "kappa"
  , CreateFitRequest -> Maybe Int
createFitRequestMaxDepth :: !(Maybe Int) -- ^ "max_depth"
  , CreateFitRequest -> Maybe Int
createFitRequestNumSamples :: !(Maybe Int) -- ^ "num_samples"
  , CreateFitRequest -> Maybe Int
createFitRequestNumThin :: !(Maybe Int) -- ^ "num_thin"
  , CreateFitRequest -> Maybe Int
createFitRequestNumWarmup :: !(Maybe Int) -- ^ "num_warmup"
  , CreateFitRequest -> Maybe Int
createFitRequestRandomSeed :: !(Maybe Int) -- ^ "random_seed"
  , CreateFitRequest -> Maybe Int
createFitRequestRefresh :: !(Maybe Int) -- ^ "refresh"
  , CreateFitRequest -> Maybe Bool
createFitRequestSaveWarmup :: !(Maybe Bool) -- ^ "save_warmup"
  , CreateFitRequest -> Maybe Double
createFitRequestStepsize :: !(Maybe Double) -- ^ "stepsize"
  , CreateFitRequest -> Maybe Double
createFitRequestStepsizeJitter :: !(Maybe Double) -- ^ "stepsize_jitter"
  , CreateFitRequest -> Maybe Double
createFitRequestT0 :: !(Maybe Double) -- ^ "t0"
  , CreateFitRequest -> Maybe Int
createFitRequestTermBuffer :: !(Maybe Int) -- ^ "term_buffer"
  , CreateFitRequest -> Maybe Int
createFitRequestWindow :: !(Maybe Int) -- ^ "window"
  } deriving (Int -> CreateFitRequest -> ShowS
[CreateFitRequest] -> ShowS
CreateFitRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CreateFitRequest] -> ShowS
$cshowList :: [CreateFitRequest] -> ShowS
show :: CreateFitRequest -> [Char]
$cshow :: CreateFitRequest -> [Char]
showsPrec :: Int -> CreateFitRequest -> ShowS
$cshowsPrec :: Int -> CreateFitRequest -> ShowS
P.Show, CreateFitRequest -> CreateFitRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFitRequest -> CreateFitRequest -> Bool
$c/= :: CreateFitRequest -> CreateFitRequest -> Bool
== :: CreateFitRequest -> CreateFitRequest -> Bool
$c== :: CreateFitRequest -> CreateFitRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateFitRequest
instance A.FromJSON CreateFitRequest where
  parseJSON :: Value -> Parser CreateFitRequest
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateFitRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Int
-> Maybe Value
-> Maybe Double
-> E'Function
-> Maybe Double
-> Maybe Value
-> Maybe Int
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Bool
-> Maybe Double
-> Maybe Double
-> Maybe Double
-> Maybe Int
-> Maybe Int
-> CreateFitRequest
CreateFitRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"chain")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"data")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"delta")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"function")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"gamma")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"init")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"init_buffer")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"init_radius")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"kappa")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"max_depth")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"num_samples")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"num_thin")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"num_warmup")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"random_seed")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refresh")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"save_warmup")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stepsize")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"stepsize_jitter")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"t0")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"term_buffer")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"window")

-- | ToJSON CreateFitRequest
instance A.ToJSON CreateFitRequest where
  toJSON :: CreateFitRequest -> Value
toJSON CreateFitRequest {Maybe Bool
Maybe Double
Maybe Int
Maybe Value
E'Function
createFitRequestWindow :: Maybe Int
createFitRequestTermBuffer :: Maybe Int
createFitRequestT0 :: Maybe Double
createFitRequestStepsizeJitter :: Maybe Double
createFitRequestStepsize :: Maybe Double
createFitRequestSaveWarmup :: Maybe Bool
createFitRequestRefresh :: Maybe Int
createFitRequestRandomSeed :: Maybe Int
createFitRequestNumWarmup :: Maybe Int
createFitRequestNumThin :: Maybe Int
createFitRequestNumSamples :: Maybe Int
createFitRequestMaxDepth :: Maybe Int
createFitRequestKappa :: Maybe Double
createFitRequestInitRadius :: Maybe Double
createFitRequestInitBuffer :: Maybe Int
createFitRequestInit :: Maybe Value
createFitRequestGamma :: Maybe Double
createFitRequestFunction :: E'Function
createFitRequestDelta :: Maybe Double
createFitRequestData :: Maybe Value
createFitRequestChain :: Maybe Int
createFitRequestWindow :: CreateFitRequest -> Maybe Int
createFitRequestTermBuffer :: CreateFitRequest -> Maybe Int
createFitRequestT0 :: CreateFitRequest -> Maybe Double
createFitRequestStepsizeJitter :: CreateFitRequest -> Maybe Double
createFitRequestStepsize :: CreateFitRequest -> Maybe Double
createFitRequestSaveWarmup :: CreateFitRequest -> Maybe Bool
createFitRequestRefresh :: CreateFitRequest -> Maybe Int
createFitRequestRandomSeed :: CreateFitRequest -> Maybe Int
createFitRequestNumWarmup :: CreateFitRequest -> Maybe Int
createFitRequestNumThin :: CreateFitRequest -> Maybe Int
createFitRequestNumSamples :: CreateFitRequest -> Maybe Int
createFitRequestMaxDepth :: CreateFitRequest -> Maybe Int
createFitRequestKappa :: CreateFitRequest -> Maybe Double
createFitRequestInitRadius :: CreateFitRequest -> Maybe Double
createFitRequestInitBuffer :: CreateFitRequest -> Maybe Int
createFitRequestInit :: CreateFitRequest -> Maybe Value
createFitRequestGamma :: CreateFitRequest -> Maybe Double
createFitRequestFunction :: CreateFitRequest -> E'Function
createFitRequestDelta :: CreateFitRequest -> Maybe Double
createFitRequestData :: CreateFitRequest -> Maybe Value
createFitRequestChain :: CreateFitRequest -> Maybe Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"chain" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestChain
      , Key
"data" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
createFitRequestData
      , Key
"delta" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
createFitRequestDelta
      , Key
"function" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= E'Function
createFitRequestFunction
      , Key
"gamma" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
createFitRequestGamma
      , Key
"init" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
createFitRequestInit
      , Key
"init_buffer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestInitBuffer
      , Key
"init_radius" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
createFitRequestInitRadius
      , Key
"kappa" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
createFitRequestKappa
      , Key
"max_depth" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestMaxDepth
      , Key
"num_samples" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestNumSamples
      , Key
"num_thin" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestNumThin
      , Key
"num_warmup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestNumWarmup
      , Key
"random_seed" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestRandomSeed
      , Key
"refresh" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestRefresh
      , Key
"save_warmup" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Bool
createFitRequestSaveWarmup
      , Key
"stepsize" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
createFitRequestStepsize
      , Key
"stepsize_jitter" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
createFitRequestStepsizeJitter
      , Key
"t0" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
createFitRequestT0
      , Key
"term_buffer" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestTermBuffer
      , Key
"window" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Int
createFitRequestWindow
      ]


-- | Construct a value of type 'CreateFitRequest' (by applying it's required fields, if any)
mkCreateFitRequest
  :: E'Function -- ^ 'createFitRequestFunction' 
  -> CreateFitRequest
mkCreateFitRequest :: E'Function -> CreateFitRequest
mkCreateFitRequest E'Function
createFitRequestFunction =
  CreateFitRequest
  { createFitRequestChain :: Maybe Int
createFitRequestChain = forall a. Maybe a
Nothing
  , createFitRequestData :: Maybe Value
createFitRequestData = forall a. Maybe a
Nothing
  , createFitRequestDelta :: Maybe Double
createFitRequestDelta = forall a. Maybe a
Nothing
  , E'Function
createFitRequestFunction :: E'Function
createFitRequestFunction :: E'Function
createFitRequestFunction
  , createFitRequestGamma :: Maybe Double
createFitRequestGamma = forall a. Maybe a
Nothing
  , createFitRequestInit :: Maybe Value
createFitRequestInit = forall a. Maybe a
Nothing
  , createFitRequestInitBuffer :: Maybe Int
createFitRequestInitBuffer = forall a. Maybe a
Nothing
  , createFitRequestInitRadius :: Maybe Double
createFitRequestInitRadius = forall a. Maybe a
Nothing
  , createFitRequestKappa :: Maybe Double
createFitRequestKappa = forall a. Maybe a
Nothing
  , createFitRequestMaxDepth :: Maybe Int
createFitRequestMaxDepth = forall a. Maybe a
Nothing
  , createFitRequestNumSamples :: Maybe Int
createFitRequestNumSamples = forall a. Maybe a
Nothing
  , createFitRequestNumThin :: Maybe Int
createFitRequestNumThin = forall a. Maybe a
Nothing
  , createFitRequestNumWarmup :: Maybe Int
createFitRequestNumWarmup = forall a. Maybe a
Nothing
  , createFitRequestRandomSeed :: Maybe Int
createFitRequestRandomSeed = forall a. Maybe a
Nothing
  , createFitRequestRefresh :: Maybe Int
createFitRequestRefresh = forall a. Maybe a
Nothing
  , createFitRequestSaveWarmup :: Maybe Bool
createFitRequestSaveWarmup = forall a. Maybe a
Nothing
  , createFitRequestStepsize :: Maybe Double
createFitRequestStepsize = forall a. Maybe a
Nothing
  , createFitRequestStepsizeJitter :: Maybe Double
createFitRequestStepsizeJitter = forall a. Maybe a
Nothing
  , createFitRequestT0 :: Maybe Double
createFitRequestT0 = forall a. Maybe a
Nothing
  , createFitRequestTermBuffer :: Maybe Int
createFitRequestTermBuffer = forall a. Maybe a
Nothing
  , createFitRequestWindow :: Maybe Int
createFitRequestWindow = forall a. Maybe a
Nothing
  }

-- ** CreateModelRequest
-- | CreateModelRequest
data CreateModelRequest = CreateModelRequest
  { CreateModelRequest -> Text
createModelRequestProgramCode :: !(Text) -- ^ /Required/ "program_code"
  } deriving (Int -> CreateModelRequest -> ShowS
[CreateModelRequest] -> ShowS
CreateModelRequest -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [CreateModelRequest] -> ShowS
$cshowList :: [CreateModelRequest] -> ShowS
show :: CreateModelRequest -> [Char]
$cshow :: CreateModelRequest -> [Char]
showsPrec :: Int -> CreateModelRequest -> ShowS
$cshowsPrec :: Int -> CreateModelRequest -> ShowS
P.Show, CreateModelRequest -> CreateModelRequest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateModelRequest -> CreateModelRequest -> Bool
$c/= :: CreateModelRequest -> CreateModelRequest -> Bool
== :: CreateModelRequest -> CreateModelRequest -> Bool
$c== :: CreateModelRequest -> CreateModelRequest -> Bool
P.Eq, P.Typeable)

-- | FromJSON CreateModelRequest
instance A.FromJSON CreateModelRequest where
  parseJSON :: Value -> Parser CreateModelRequest
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"CreateModelRequest" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> CreateModelRequest
CreateModelRequest
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"program_code")

-- | ToJSON CreateModelRequest
instance A.ToJSON CreateModelRequest where
  toJSON :: CreateModelRequest -> Value
toJSON CreateModelRequest {Text
createModelRequestProgramCode :: Text
createModelRequestProgramCode :: CreateModelRequest -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"program_code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
createModelRequestProgramCode
      ]


-- | Construct a value of type 'CreateModelRequest' (by applying it's required fields, if any)
mkCreateModelRequest
  :: Text -- ^ 'createModelRequestProgramCode' 
  -> CreateModelRequest
mkCreateModelRequest :: Text -> CreateModelRequest
mkCreateModelRequest Text
createModelRequestProgramCode =
  CreateModelRequest
  { Text
createModelRequestProgramCode :: Text
createModelRequestProgramCode :: Text
createModelRequestProgramCode
  }

-- ** Fit
-- | Fit
data Fit = Fit
  { Fit -> Text
fitName :: !(Text) -- ^ /Required/ "name"
  } deriving (Int -> Fit -> ShowS
[Fit] -> ShowS
Fit -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Fit] -> ShowS
$cshowList :: [Fit] -> ShowS
show :: Fit -> [Char]
$cshow :: Fit -> [Char]
showsPrec :: Int -> Fit -> ShowS
$cshowsPrec :: Int -> Fit -> ShowS
P.Show, Fit -> Fit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Fit -> Fit -> Bool
$c/= :: Fit -> Fit -> Bool
== :: Fit -> Fit -> Bool
$c== :: Fit -> Fit -> Bool
P.Eq, P.Typeable)

-- | FromJSON Fit
instance A.FromJSON Fit where
  parseJSON :: Value -> Parser Fit
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Fit" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Fit
Fit
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")

-- | ToJSON Fit
instance A.ToJSON Fit where
  toJSON :: Fit -> Value
toJSON Fit {Text
fitName :: Text
fitName :: Fit -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
fitName
      ]


-- | Construct a value of type 'Fit' (by applying it's required fields, if any)
mkFit
  :: Text -- ^ 'fitName' 
  -> Fit
mkFit :: Text -> Fit
mkFit Text
fitName =
  Fit
  { Text
fitName :: Text
fitName :: Text
fitName
  }

-- ** Model
-- | Model
data Model = Model
  { Model -> Text
modelCompilerOutput :: !(Text) -- ^ /Required/ "compiler_output"
  , Model -> Text
modelName :: !(Text) -- ^ /Required/ "name"
  , Model -> Text
modelStancWarnings :: !(Text) -- ^ /Required/ "stanc_warnings"
  } deriving (Int -> Model -> ShowS
[Model] -> ShowS
Model -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Model] -> ShowS
$cshowList :: [Model] -> ShowS
show :: Model -> [Char]
$cshow :: Model -> [Char]
showsPrec :: Int -> Model -> ShowS
$cshowsPrec :: Int -> Model -> ShowS
P.Show, Model -> Model -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Model -> Model -> Bool
$c/= :: Model -> Model -> Bool
== :: Model -> Model -> Bool
$c== :: Model -> Model -> Bool
P.Eq, P.Typeable)

-- | FromJSON Model
instance A.FromJSON Model where
  parseJSON :: Value -> Parser Model
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Model" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Text -> Model
Model
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"compiler_output")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"stanc_warnings")

-- | ToJSON Model
instance A.ToJSON Model where
  toJSON :: Model -> Value
toJSON Model {Text
modelStancWarnings :: Text
modelName :: Text
modelCompilerOutput :: Text
modelStancWarnings :: Model -> Text
modelName :: Model -> Text
modelCompilerOutput :: Model -> Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"compiler_output" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
modelCompilerOutput
      , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
modelName
      , Key
"stanc_warnings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
modelStancWarnings
      ]


-- | Construct a value of type 'Model' (by applying it's required fields, if any)
mkModel
  :: Text -- ^ 'modelCompilerOutput' 
  -> Text -- ^ 'modelName' 
  -> Text -- ^ 'modelStancWarnings' 
  -> Model
mkModel :: Text -> Text -> Text -> Model
mkModel Text
modelCompilerOutput Text
modelName Text
modelStancWarnings =
  Model
  { Text
modelCompilerOutput :: Text
modelCompilerOutput :: Text
modelCompilerOutput
  , Text
modelName :: Text
modelName :: Text
modelName
  , Text
modelStancWarnings :: Text
modelStancWarnings :: Text
modelStancWarnings
  }

-- ** Operation
-- | Operation
data Operation = Operation
  { Operation -> Bool
operationDone :: !(Bool) -- ^ /Required/ "done"
  , Operation -> Maybe Value
operationMetadata :: !(Maybe A.Value) -- ^ "metadata"
  , Operation -> Text
operationName :: !(Text) -- ^ /Required/ "name"
  , Operation -> Maybe Value
operationResult :: !(Maybe A.Value) -- ^ "result"
  } deriving (Int -> Operation -> ShowS
[Operation] -> ShowS
Operation -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Operation] -> ShowS
$cshowList :: [Operation] -> ShowS
show :: Operation -> [Char]
$cshow :: Operation -> [Char]
showsPrec :: Int -> Operation -> ShowS
$cshowsPrec :: Int -> Operation -> ShowS
P.Show, Operation -> Operation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Operation -> Operation -> Bool
$c/= :: Operation -> Operation -> Bool
== :: Operation -> Operation -> Bool
$c== :: Operation -> Operation -> Bool
P.Eq, P.Typeable)

-- | FromJSON Operation
instance A.FromJSON Operation where
  parseJSON :: Value -> Parser Operation
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Operation" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Bool -> Maybe Value -> Text -> Maybe Value -> Operation
Operation
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"done")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"metadata")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"result")

-- | ToJSON Operation
instance A.ToJSON Operation where
  toJSON :: Operation -> Value
toJSON Operation {Bool
Maybe Value
Text
operationResult :: Maybe Value
operationName :: Text
operationMetadata :: Maybe Value
operationDone :: Bool
operationResult :: Operation -> Maybe Value
operationName :: Operation -> Text
operationMetadata :: Operation -> Maybe Value
operationDone :: Operation -> Bool
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"done" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Bool
operationDone
      , Key
"metadata" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
operationMetadata
      , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
operationName
      , Key
"result" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Value
operationResult
      ]


-- | Construct a value of type 'Operation' (by applying it's required fields, if any)
mkOperation
  :: Bool -- ^ 'operationDone' 
  -> Text -- ^ 'operationName' 
  -> Operation
mkOperation :: Bool -> Text -> Operation
mkOperation Bool
operationDone Text
operationName =
  Operation
  { Bool
operationDone :: Bool
operationDone :: Bool
operationDone
  , operationMetadata :: Maybe Value
operationMetadata = forall a. Maybe a
Nothing
  , Text
operationName :: Text
operationName :: Text
operationName
  , operationResult :: Maybe Value
operationResult = forall a. Maybe a
Nothing
  }

-- ** Parameter
-- | Parameter
data Parameter = Parameter
  { Parameter -> [Text]
parameterConstrainedNames :: !([Text]) -- ^ /Required/ "constrained_names"
  , Parameter -> [Int]
parameterDims :: !([Int]) -- ^ /Required/ "dims"
  , Parameter -> Text
parameterName :: !(Text) -- ^ /Required/ "name"
  } deriving (Int -> Parameter -> ShowS
[Parameter] -> ShowS
Parameter -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Parameter] -> ShowS
$cshowList :: [Parameter] -> ShowS
show :: Parameter -> [Char]
$cshow :: Parameter -> [Char]
showsPrec :: Int -> Parameter -> ShowS
$cshowsPrec :: Int -> Parameter -> ShowS
P.Show, Parameter -> Parameter -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameter -> Parameter -> Bool
$c/= :: Parameter -> Parameter -> Bool
== :: Parameter -> Parameter -> Bool
$c== :: Parameter -> Parameter -> Bool
P.Eq, P.Typeable)

-- | FromJSON Parameter
instance A.FromJSON Parameter where
  parseJSON :: Value -> Parser Parameter
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Parameter" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    [Text] -> [Int] -> Text -> Parameter
Parameter
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"constrained_names")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"dims")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"name")

-- | ToJSON Parameter
instance A.ToJSON Parameter where
  toJSON :: Parameter -> Value
toJSON Parameter {[Int]
[Text]
Text
parameterName :: Text
parameterDims :: [Int]
parameterConstrainedNames :: [Text]
parameterName :: Parameter -> Text
parameterDims :: Parameter -> [Int]
parameterConstrainedNames :: Parameter -> [Text]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"constrained_names" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Text]
parameterConstrainedNames
      , Key
"dims" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= [Int]
parameterDims
      , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
parameterName
      ]


-- | Construct a value of type 'Parameter' (by applying it's required fields, if any)
mkParameter
  :: [Text] -- ^ 'parameterConstrainedNames' 
  -> [Int] -- ^ 'parameterDims' 
  -> Text -- ^ 'parameterName' 
  -> Parameter
mkParameter :: [Text] -> [Int] -> Text -> Parameter
mkParameter [Text]
parameterConstrainedNames [Int]
parameterDims Text
parameterName =
  Parameter
  { [Text]
parameterConstrainedNames :: [Text]
parameterConstrainedNames :: [Text]
parameterConstrainedNames
  , [Int]
parameterDims :: [Int]
parameterDims :: [Int]
parameterDims
  , Text
parameterName :: Text
parameterName :: Text
parameterName
  }

-- ** Status
-- | Status
data Status = Status
  { Status -> Int
statusCode :: !(Int) -- ^ /Required/ "code"
  , Status -> Maybe [Value]
statusDetails :: !(Maybe [A.Value]) -- ^ "details"
  , Status -> Text
statusMessage :: !(Text) -- ^ /Required/ "message"
  , Status -> Text
statusStatus :: !(Text) -- ^ /Required/ "status"
  } deriving (Int -> Status -> ShowS
[Status] -> ShowS
Status -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> [Char]
$cshow :: Status -> [Char]
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
P.Show, Status -> Status -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
P.Eq, P.Typeable)

-- | FromJSON Status
instance A.FromJSON Status where
  parseJSON :: Value -> Parser Status
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Status" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Int -> Maybe [Value] -> Text -> Text -> Status
Status
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"code")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"details")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"message")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.:  Key
"status")

-- | ToJSON Status
instance A.ToJSON Status where
  toJSON :: Status -> Value
toJSON Status {Int
Maybe [Value]
Text
statusStatus :: Text
statusMessage :: Text
statusDetails :: Maybe [Value]
statusCode :: Int
statusStatus :: Status -> Text
statusMessage :: Status -> Text
statusDetails :: Status -> Maybe [Value]
statusCode :: Status -> Int
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"code" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int
statusCode
      , Key
"details" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Value]
statusDetails
      , Key
"message" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
statusMessage
      , Key
"status" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
statusStatus
      ]


-- | Construct a value of type 'Status' (by applying it's required fields, if any)
mkStatus
  :: Int -- ^ 'statusCode' 
  -> Text -- ^ 'statusMessage' 
  -> Text -- ^ 'statusStatus' 
  -> Status
mkStatus :: Int -> Text -> Text -> Status
mkStatus Int
statusCode Text
statusMessage Text
statusStatus =
  Status
  { Int
statusCode :: Int
statusCode :: Int
statusCode
  , statusDetails :: Maybe [Value]
statusDetails = forall a. Maybe a
Nothing
  , Text
statusMessage :: Text
statusMessage :: Text
statusMessage
  , Text
statusStatus :: Text
statusStatus :: Text
statusStatus
  }

-- ** V1ModelsGet200Response
-- | V1ModelsGet200Response
data V1ModelsGet200Response = V1ModelsGet200Response
  { V1ModelsGet200Response -> Maybe [Model]
v1ModelsGet200ResponseModels :: !(Maybe [Model]) -- ^ "models"
  } deriving (Int -> V1ModelsGet200Response -> ShowS
[V1ModelsGet200Response] -> ShowS
V1ModelsGet200Response -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [V1ModelsGet200Response] -> ShowS
$cshowList :: [V1ModelsGet200Response] -> ShowS
show :: V1ModelsGet200Response -> [Char]
$cshow :: V1ModelsGet200Response -> [Char]
showsPrec :: Int -> V1ModelsGet200Response -> ShowS
$cshowsPrec :: Int -> V1ModelsGet200Response -> ShowS
P.Show, V1ModelsGet200Response -> V1ModelsGet200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1ModelsGet200Response -> V1ModelsGet200Response -> Bool
$c/= :: V1ModelsGet200Response -> V1ModelsGet200Response -> Bool
== :: V1ModelsGet200Response -> V1ModelsGet200Response -> Bool
$c== :: V1ModelsGet200Response -> V1ModelsGet200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1ModelsGet200Response
instance A.FromJSON V1ModelsGet200Response where
  parseJSON :: Value -> Parser V1ModelsGet200Response
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"V1ModelsGet200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Model] -> V1ModelsGet200Response
V1ModelsGet200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"models")

-- | ToJSON V1ModelsGet200Response
instance A.ToJSON V1ModelsGet200Response where
  toJSON :: V1ModelsGet200Response -> Value
toJSON V1ModelsGet200Response {Maybe [Model]
v1ModelsGet200ResponseModels :: Maybe [Model]
v1ModelsGet200ResponseModels :: V1ModelsGet200Response -> Maybe [Model]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"models" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Model]
v1ModelsGet200ResponseModels
      ]


-- | Construct a value of type 'V1ModelsGet200Response' (by applying it's required fields, if any)
mkV1ModelsGet200Response
  :: V1ModelsGet200Response
mkV1ModelsGet200Response :: V1ModelsGet200Response
mkV1ModelsGet200Response =
  V1ModelsGet200Response
  { v1ModelsGet200ResponseModels :: Maybe [Model]
v1ModelsGet200ResponseModels = forall a. Maybe a
Nothing
  }

-- ** V1ModelsModelIdLogProbGradPost200Response
-- | V1ModelsModelIdLogProbGradPost200Response
data V1ModelsModelIdLogProbGradPost200Response = V1ModelsModelIdLogProbGradPost200Response
  { V1ModelsModelIdLogProbGradPost200Response -> Maybe [Double]
v1ModelsModelIdLogProbGradPost200ResponseGradLogProb :: !(Maybe [Double]) -- ^ "grad_log_prob"
  } deriving (Int -> V1ModelsModelIdLogProbGradPost200Response -> ShowS
[V1ModelsModelIdLogProbGradPost200Response] -> ShowS
V1ModelsModelIdLogProbGradPost200Response -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [V1ModelsModelIdLogProbGradPost200Response] -> ShowS
$cshowList :: [V1ModelsModelIdLogProbGradPost200Response] -> ShowS
show :: V1ModelsModelIdLogProbGradPost200Response -> [Char]
$cshow :: V1ModelsModelIdLogProbGradPost200Response -> [Char]
showsPrec :: Int -> V1ModelsModelIdLogProbGradPost200Response -> ShowS
$cshowsPrec :: Int -> V1ModelsModelIdLogProbGradPost200Response -> ShowS
P.Show, V1ModelsModelIdLogProbGradPost200Response
-> V1ModelsModelIdLogProbGradPost200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1ModelsModelIdLogProbGradPost200Response
-> V1ModelsModelIdLogProbGradPost200Response -> Bool
$c/= :: V1ModelsModelIdLogProbGradPost200Response
-> V1ModelsModelIdLogProbGradPost200Response -> Bool
== :: V1ModelsModelIdLogProbGradPost200Response
-> V1ModelsModelIdLogProbGradPost200Response -> Bool
$c== :: V1ModelsModelIdLogProbGradPost200Response
-> V1ModelsModelIdLogProbGradPost200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1ModelsModelIdLogProbGradPost200Response
instance A.FromJSON V1ModelsModelIdLogProbGradPost200Response where
  parseJSON :: Value -> Parser V1ModelsModelIdLogProbGradPost200Response
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"V1ModelsModelIdLogProbGradPost200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Double] -> V1ModelsModelIdLogProbGradPost200Response
V1ModelsModelIdLogProbGradPost200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"grad_log_prob")

-- | ToJSON V1ModelsModelIdLogProbGradPost200Response
instance A.ToJSON V1ModelsModelIdLogProbGradPost200Response where
  toJSON :: V1ModelsModelIdLogProbGradPost200Response -> Value
toJSON V1ModelsModelIdLogProbGradPost200Response {Maybe [Double]
v1ModelsModelIdLogProbGradPost200ResponseGradLogProb :: Maybe [Double]
v1ModelsModelIdLogProbGradPost200ResponseGradLogProb :: V1ModelsModelIdLogProbGradPost200Response -> Maybe [Double]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"grad_log_prob" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Double]
v1ModelsModelIdLogProbGradPost200ResponseGradLogProb
      ]


-- | Construct a value of type 'V1ModelsModelIdLogProbGradPost200Response' (by applying it's required fields, if any)
mkV1ModelsModelIdLogProbGradPost200Response
  :: V1ModelsModelIdLogProbGradPost200Response
mkV1ModelsModelIdLogProbGradPost200Response :: V1ModelsModelIdLogProbGradPost200Response
mkV1ModelsModelIdLogProbGradPost200Response =
  V1ModelsModelIdLogProbGradPost200Response
  { v1ModelsModelIdLogProbGradPost200ResponseGradLogProb :: Maybe [Double]
v1ModelsModelIdLogProbGradPost200ResponseGradLogProb = forall a. Maybe a
Nothing
  }

-- ** V1ModelsModelIdLogProbPost200Response
-- | V1ModelsModelIdLogProbPost200Response
data V1ModelsModelIdLogProbPost200Response = V1ModelsModelIdLogProbPost200Response
  { V1ModelsModelIdLogProbPost200Response -> Maybe Double
v1ModelsModelIdLogProbPost200ResponseLogProb :: !(Maybe Double) -- ^ "log_prob"
  } deriving (Int -> V1ModelsModelIdLogProbPost200Response -> ShowS
[V1ModelsModelIdLogProbPost200Response] -> ShowS
V1ModelsModelIdLogProbPost200Response -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [V1ModelsModelIdLogProbPost200Response] -> ShowS
$cshowList :: [V1ModelsModelIdLogProbPost200Response] -> ShowS
show :: V1ModelsModelIdLogProbPost200Response -> [Char]
$cshow :: V1ModelsModelIdLogProbPost200Response -> [Char]
showsPrec :: Int -> V1ModelsModelIdLogProbPost200Response -> ShowS
$cshowsPrec :: Int -> V1ModelsModelIdLogProbPost200Response -> ShowS
P.Show, V1ModelsModelIdLogProbPost200Response
-> V1ModelsModelIdLogProbPost200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1ModelsModelIdLogProbPost200Response
-> V1ModelsModelIdLogProbPost200Response -> Bool
$c/= :: V1ModelsModelIdLogProbPost200Response
-> V1ModelsModelIdLogProbPost200Response -> Bool
== :: V1ModelsModelIdLogProbPost200Response
-> V1ModelsModelIdLogProbPost200Response -> Bool
$c== :: V1ModelsModelIdLogProbPost200Response
-> V1ModelsModelIdLogProbPost200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1ModelsModelIdLogProbPost200Response
instance A.FromJSON V1ModelsModelIdLogProbPost200Response where
  parseJSON :: Value -> Parser V1ModelsModelIdLogProbPost200Response
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"V1ModelsModelIdLogProbPost200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Double -> V1ModelsModelIdLogProbPost200Response
V1ModelsModelIdLogProbPost200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"log_prob")

-- | ToJSON V1ModelsModelIdLogProbPost200Response
instance A.ToJSON V1ModelsModelIdLogProbPost200Response where
  toJSON :: V1ModelsModelIdLogProbPost200Response -> Value
toJSON V1ModelsModelIdLogProbPost200Response {Maybe Double
v1ModelsModelIdLogProbPost200ResponseLogProb :: Maybe Double
v1ModelsModelIdLogProbPost200ResponseLogProb :: V1ModelsModelIdLogProbPost200Response -> Maybe Double
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"log_prob" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Double
v1ModelsModelIdLogProbPost200ResponseLogProb
      ]


-- | Construct a value of type 'V1ModelsModelIdLogProbPost200Response' (by applying it's required fields, if any)
mkV1ModelsModelIdLogProbPost200Response
  :: V1ModelsModelIdLogProbPost200Response
mkV1ModelsModelIdLogProbPost200Response :: V1ModelsModelIdLogProbPost200Response
mkV1ModelsModelIdLogProbPost200Response =
  V1ModelsModelIdLogProbPost200Response
  { v1ModelsModelIdLogProbPost200ResponseLogProb :: Maybe Double
v1ModelsModelIdLogProbPost200ResponseLogProb = forall a. Maybe a
Nothing
  }

-- ** V1ModelsModelIdParamsPost200Response
-- | V1ModelsModelIdParamsPost200Response
data V1ModelsModelIdParamsPost200Response = V1ModelsModelIdParamsPost200Response
  { V1ModelsModelIdParamsPost200Response -> Maybe Text
v1ModelsModelIdParamsPost200ResponseId :: !(Maybe Text) -- ^ "id"
  , V1ModelsModelIdParamsPost200Response -> Maybe [Parameter]
v1ModelsModelIdParamsPost200ResponseParams :: !(Maybe [Parameter]) -- ^ "params"
  } deriving (Int -> V1ModelsModelIdParamsPost200Response -> ShowS
[V1ModelsModelIdParamsPost200Response] -> ShowS
V1ModelsModelIdParamsPost200Response -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [V1ModelsModelIdParamsPost200Response] -> ShowS
$cshowList :: [V1ModelsModelIdParamsPost200Response] -> ShowS
show :: V1ModelsModelIdParamsPost200Response -> [Char]
$cshow :: V1ModelsModelIdParamsPost200Response -> [Char]
showsPrec :: Int -> V1ModelsModelIdParamsPost200Response -> ShowS
$cshowsPrec :: Int -> V1ModelsModelIdParamsPost200Response -> ShowS
P.Show, V1ModelsModelIdParamsPost200Response
-> V1ModelsModelIdParamsPost200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1ModelsModelIdParamsPost200Response
-> V1ModelsModelIdParamsPost200Response -> Bool
$c/= :: V1ModelsModelIdParamsPost200Response
-> V1ModelsModelIdParamsPost200Response -> Bool
== :: V1ModelsModelIdParamsPost200Response
-> V1ModelsModelIdParamsPost200Response -> Bool
$c== :: V1ModelsModelIdParamsPost200Response
-> V1ModelsModelIdParamsPost200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1ModelsModelIdParamsPost200Response
instance A.FromJSON V1ModelsModelIdParamsPost200Response where
  parseJSON :: Value -> Parser V1ModelsModelIdParamsPost200Response
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"V1ModelsModelIdParamsPost200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe Text
-> Maybe [Parameter] -> V1ModelsModelIdParamsPost200Response
V1ModelsModelIdParamsPost200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"id")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params")

-- | ToJSON V1ModelsModelIdParamsPost200Response
instance A.ToJSON V1ModelsModelIdParamsPost200Response where
  toJSON :: V1ModelsModelIdParamsPost200Response -> Value
toJSON V1ModelsModelIdParamsPost200Response {Maybe [Parameter]
Maybe Text
v1ModelsModelIdParamsPost200ResponseParams :: Maybe [Parameter]
v1ModelsModelIdParamsPost200ResponseId :: Maybe Text
v1ModelsModelIdParamsPost200ResponseParams :: V1ModelsModelIdParamsPost200Response -> Maybe [Parameter]
v1ModelsModelIdParamsPost200ResponseId :: V1ModelsModelIdParamsPost200Response -> Maybe Text
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
v1ModelsModelIdParamsPost200ResponseId
      , Key
"params" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Parameter]
v1ModelsModelIdParamsPost200ResponseParams
      ]


-- | Construct a value of type 'V1ModelsModelIdParamsPost200Response' (by applying it's required fields, if any)
mkV1ModelsModelIdParamsPost200Response
  :: V1ModelsModelIdParamsPost200Response
mkV1ModelsModelIdParamsPost200Response :: V1ModelsModelIdParamsPost200Response
mkV1ModelsModelIdParamsPost200Response =
  V1ModelsModelIdParamsPost200Response
  { v1ModelsModelIdParamsPost200ResponseId :: Maybe Text
v1ModelsModelIdParamsPost200ResponseId = forall a. Maybe a
Nothing
  , v1ModelsModelIdParamsPost200ResponseParams :: Maybe [Parameter]
v1ModelsModelIdParamsPost200ResponseParams = forall a. Maybe a
Nothing
  }

-- ** V1ModelsModelIdTransformInitsPost200Response
-- | V1ModelsModelIdTransformInitsPost200Response
data V1ModelsModelIdTransformInitsPost200Response = V1ModelsModelIdTransformInitsPost200Response
  { V1ModelsModelIdTransformInitsPost200Response -> Maybe [Double]
v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained :: !(Maybe [Double]) -- ^ "params_r_unconstrained"
  } deriving (Int -> V1ModelsModelIdTransformInitsPost200Response -> ShowS
[V1ModelsModelIdTransformInitsPost200Response] -> ShowS
V1ModelsModelIdTransformInitsPost200Response -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [V1ModelsModelIdTransformInitsPost200Response] -> ShowS
$cshowList :: [V1ModelsModelIdTransformInitsPost200Response] -> ShowS
show :: V1ModelsModelIdTransformInitsPost200Response -> [Char]
$cshow :: V1ModelsModelIdTransformInitsPost200Response -> [Char]
showsPrec :: Int -> V1ModelsModelIdTransformInitsPost200Response -> ShowS
$cshowsPrec :: Int -> V1ModelsModelIdTransformInitsPost200Response -> ShowS
P.Show, V1ModelsModelIdTransformInitsPost200Response
-> V1ModelsModelIdTransformInitsPost200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1ModelsModelIdTransformInitsPost200Response
-> V1ModelsModelIdTransformInitsPost200Response -> Bool
$c/= :: V1ModelsModelIdTransformInitsPost200Response
-> V1ModelsModelIdTransformInitsPost200Response -> Bool
== :: V1ModelsModelIdTransformInitsPost200Response
-> V1ModelsModelIdTransformInitsPost200Response -> Bool
$c== :: V1ModelsModelIdTransformInitsPost200Response
-> V1ModelsModelIdTransformInitsPost200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1ModelsModelIdTransformInitsPost200Response
instance A.FromJSON V1ModelsModelIdTransformInitsPost200Response where
  parseJSON :: Value -> Parser V1ModelsModelIdTransformInitsPost200Response
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"V1ModelsModelIdTransformInitsPost200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Double] -> V1ModelsModelIdTransformInitsPost200Response
V1ModelsModelIdTransformInitsPost200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params_r_unconstrained")

-- | ToJSON V1ModelsModelIdTransformInitsPost200Response
instance A.ToJSON V1ModelsModelIdTransformInitsPost200Response where
  toJSON :: V1ModelsModelIdTransformInitsPost200Response -> Value
toJSON V1ModelsModelIdTransformInitsPost200Response {Maybe [Double]
v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained :: Maybe [Double]
v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained :: V1ModelsModelIdTransformInitsPost200Response -> Maybe [Double]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"params_r_unconstrained" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Double]
v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained
      ]


-- | Construct a value of type 'V1ModelsModelIdTransformInitsPost200Response' (by applying it's required fields, if any)
mkV1ModelsModelIdTransformInitsPost200Response
  :: V1ModelsModelIdTransformInitsPost200Response
mkV1ModelsModelIdTransformInitsPost200Response :: V1ModelsModelIdTransformInitsPost200Response
mkV1ModelsModelIdTransformInitsPost200Response =
  V1ModelsModelIdTransformInitsPost200Response
  { v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained :: Maybe [Double]
v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained = forall a. Maybe a
Nothing
  }

-- ** V1ModelsModelIdWriteArrayPost200Response
-- | V1ModelsModelIdWriteArrayPost200Response
data V1ModelsModelIdWriteArrayPost200Response = V1ModelsModelIdWriteArrayPost200Response
  { V1ModelsModelIdWriteArrayPost200Response -> Maybe [Double]
v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained :: !(Maybe [Double]) -- ^ "params_r_constrained"
  } deriving (Int -> V1ModelsModelIdWriteArrayPost200Response -> ShowS
[V1ModelsModelIdWriteArrayPost200Response] -> ShowS
V1ModelsModelIdWriteArrayPost200Response -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [V1ModelsModelIdWriteArrayPost200Response] -> ShowS
$cshowList :: [V1ModelsModelIdWriteArrayPost200Response] -> ShowS
show :: V1ModelsModelIdWriteArrayPost200Response -> [Char]
$cshow :: V1ModelsModelIdWriteArrayPost200Response -> [Char]
showsPrec :: Int -> V1ModelsModelIdWriteArrayPost200Response -> ShowS
$cshowsPrec :: Int -> V1ModelsModelIdWriteArrayPost200Response -> ShowS
P.Show, V1ModelsModelIdWriteArrayPost200Response
-> V1ModelsModelIdWriteArrayPost200Response -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: V1ModelsModelIdWriteArrayPost200Response
-> V1ModelsModelIdWriteArrayPost200Response -> Bool
$c/= :: V1ModelsModelIdWriteArrayPost200Response
-> V1ModelsModelIdWriteArrayPost200Response -> Bool
== :: V1ModelsModelIdWriteArrayPost200Response
-> V1ModelsModelIdWriteArrayPost200Response -> Bool
$c== :: V1ModelsModelIdWriteArrayPost200Response
-> V1ModelsModelIdWriteArrayPost200Response -> Bool
P.Eq, P.Typeable)

-- | FromJSON V1ModelsModelIdWriteArrayPost200Response
instance A.FromJSON V1ModelsModelIdWriteArrayPost200Response where
  parseJSON :: Value -> Parser V1ModelsModelIdWriteArrayPost200Response
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"V1ModelsModelIdWriteArrayPost200Response" forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Maybe [Double] -> V1ModelsModelIdWriteArrayPost200Response
V1ModelsModelIdWriteArrayPost200Response
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"params_r_constrained")

-- | ToJSON V1ModelsModelIdWriteArrayPost200Response
instance A.ToJSON V1ModelsModelIdWriteArrayPost200Response where
  toJSON :: V1ModelsModelIdWriteArrayPost200Response -> Value
toJSON V1ModelsModelIdWriteArrayPost200Response {Maybe [Double]
v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained :: Maybe [Double]
v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained :: V1ModelsModelIdWriteArrayPost200Response -> Maybe [Double]
..} =
   [(Key, Value)] -> Value
_omitNulls
      [ Key
"params_r_constrained" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe [Double]
v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained
      ]


-- | Construct a value of type 'V1ModelsModelIdWriteArrayPost200Response' (by applying it's required fields, if any)
mkV1ModelsModelIdWriteArrayPost200Response
  :: V1ModelsModelIdWriteArrayPost200Response
mkV1ModelsModelIdWriteArrayPost200Response :: V1ModelsModelIdWriteArrayPost200Response
mkV1ModelsModelIdWriteArrayPost200Response =
  V1ModelsModelIdWriteArrayPost200Response
  { v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained :: Maybe [Double]
v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained = forall a. Maybe a
Nothing
  }


-- * Enums


-- ** E'Function

-- | Enum of 'Text'
data E'Function
  = E'Function'Hmc_nuts_diag_e_adapt -- ^ @"stan::services::sample::hmc_nuts_diag_e_adapt"@
  | E'Function'Fixed_param -- ^ @"stan::services::sample::fixed_param"@
  deriving (Int -> E'Function -> ShowS
[E'Function] -> ShowS
E'Function -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [E'Function] -> ShowS
$cshowList :: [E'Function] -> ShowS
show :: E'Function -> [Char]
$cshow :: E'Function -> [Char]
showsPrec :: Int -> E'Function -> ShowS
$cshowsPrec :: Int -> E'Function -> ShowS
P.Show, E'Function -> E'Function -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: E'Function -> E'Function -> Bool
$c/= :: E'Function -> E'Function -> Bool
== :: E'Function -> E'Function -> Bool
$c== :: E'Function -> E'Function -> Bool
P.Eq, P.Typeable, Eq E'Function
E'Function -> E'Function -> Bool
E'Function -> E'Function -> Ordering
E'Function -> E'Function -> E'Function
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
min :: E'Function -> E'Function -> E'Function
$cmin :: E'Function -> E'Function -> E'Function
max :: E'Function -> E'Function -> E'Function
$cmax :: E'Function -> E'Function -> E'Function
>= :: E'Function -> E'Function -> Bool
$c>= :: E'Function -> E'Function -> Bool
> :: E'Function -> E'Function -> Bool
$c> :: E'Function -> E'Function -> Bool
<= :: E'Function -> E'Function -> Bool
$c<= :: E'Function -> E'Function -> Bool
< :: E'Function -> E'Function -> Bool
$c< :: E'Function -> E'Function -> Bool
compare :: E'Function -> E'Function -> Ordering
$ccompare :: E'Function -> E'Function -> Ordering
P.Ord, E'Function
forall a. a -> a -> Bounded a
maxBound :: E'Function
$cmaxBound :: E'Function
minBound :: E'Function
$cminBound :: E'Function
P.Bounded, Int -> E'Function
E'Function -> Int
E'Function -> [E'Function]
E'Function -> E'Function
E'Function -> E'Function -> [E'Function]
E'Function -> E'Function -> E'Function -> [E'Function]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: E'Function -> E'Function -> E'Function -> [E'Function]
$cenumFromThenTo :: E'Function -> E'Function -> E'Function -> [E'Function]
enumFromTo :: E'Function -> E'Function -> [E'Function]
$cenumFromTo :: E'Function -> E'Function -> [E'Function]
enumFromThen :: E'Function -> E'Function -> [E'Function]
$cenumFromThen :: E'Function -> E'Function -> [E'Function]
enumFrom :: E'Function -> [E'Function]
$cenumFrom :: E'Function -> [E'Function]
fromEnum :: E'Function -> Int
$cfromEnum :: E'Function -> Int
toEnum :: Int -> E'Function
$ctoEnum :: Int -> E'Function
pred :: E'Function -> E'Function
$cpred :: E'Function -> E'Function
succ :: E'Function -> E'Function
$csucc :: E'Function -> E'Function
P.Enum)

instance A.ToJSON E'Function where toJSON :: E'Function -> Value
toJSON = forall a. ToJSON a => a -> Value
A.toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Function -> Text
fromE'Function
instance A.FromJSON E'Function where parseJSON :: Value -> Parser E'Function
parseJSON Value
o = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
P.either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
P.fail (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> a
P.id) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Function
toE'Function forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
o
instance WH.ToHttpApiData E'Function where toQueryParam :: E'Function -> Text
toQueryParam = forall a. ToHttpApiData a => a -> Text
WH.toQueryParam forall b c a. (b -> c) -> (a -> b) -> a -> c
. E'Function -> Text
fromE'Function
instance WH.FromHttpApiData E'Function where parseQueryParam :: Text -> Either Text E'Function
parseQueryParam Text
o = forall a. FromHttpApiData a => Text -> Either Text a
WH.parseQueryParam Text
o forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
P.left [Char] -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] E'Function
toE'Function
instance MimeRender MimeMultipartFormData E'Function where mimeRender :: Proxy MimeMultipartFormData -> E'Function -> ByteString
mimeRender Proxy MimeMultipartFormData
_ = forall a. ToHttpApiData a => a -> ByteString
mimeRenderDefaultMultipartFormData

-- | unwrap 'E'Function' enum
fromE'Function :: E'Function -> Text
fromE'Function :: E'Function -> Text
fromE'Function = \case
  E'Function
E'Function'Hmc_nuts_diag_e_adapt -> Text
"stan::services::sample::hmc_nuts_diag_e_adapt"
  E'Function
E'Function'Fixed_param -> Text
"stan::services::sample::fixed_param"

-- | parse 'E'Function' enum
toE'Function :: Text -> P.Either String E'Function
toE'Function :: Text -> Either [Char] E'Function
toE'Function = \case
  Text
"stan::services::sample::hmc_nuts_diag_e_adapt" -> forall a b. b -> Either a b
P.Right E'Function
E'Function'Hmc_nuts_diag_e_adapt
  Text
"stan::services::sample::fixed_param" -> forall a b. b -> Either a b
P.Right E'Function
E'Function'Fixed_param
  Text
s -> forall a b. a -> Either a b
P.Left forall a b. (a -> b) -> a -> b
$ [Char]
"toE'Function: enum parse failure: " forall a. [a] -> [a] -> [a]
P.++ forall a. Show a => a -> [Char]
P.show Text
s