packages feed

httpstan (empty) → 0.2.0.0

raw patch · 20 files changed

+4057/−0 lines, 20 filesdep +QuickCheckdep +aesondep +basesetup-changed

Dependencies added: QuickCheck, aeson, base, base64-bytestring, bytestring, case-insensitive, containers, deepseq, exceptions, hspec, http-api-data, http-client, http-client-tls, http-media, http-types, httpstan, iso8601-time, katip, microlens, monad-logger, mtl, network, random, safe-exceptions, semigroups, text, time, transformers, unordered-containers, vector

Files

+ LICENSE view
@@ -0,0 +1,26 @@+Copyright 2023 Jake McArthur++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this+list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice,+this list of conditions and the following disclaimer in the documentation and/or+other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors+may be used to endorse or promote products derived from this software without+specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES+(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;+LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,203 @@+## OpenAPI Auto-Generated [http-client](https://www.stackage.org/lts-10.0/package/http-client-0.5.7.1) Bindings to `httpstan`++The library in `lib` provides auto-generated-from-OpenAPI [http-client](https://www.stackage.org/lts-10.0/package/http-client-0.5.7.1) bindings to the httpstan API.++OpenApi Version: 3.0.1++## Installation++Installation follows the standard approach to installing Stack-based projects.++1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).+2. To build the package, and generate the documentation (recommended):+```+stack haddock+```+which will generate docs for this lib in the `docs` folder.++To generate the docs in the normal location (to enable hyperlinks to external libs), remove+```+build:+  haddock-arguments:+    haddock-args:+    - "--odir=./docs"+```+from the stack.yaml file and run `stack haddock` again.++3. To run unit tests:+```+stack test+```++## OpenAPI-Generator++The code generator that produced this library, and which explains how+to obtain and use the openapi-generator cli tool lives at++https://openapi-generator.tech++The _generator-name_ argument (`--generator-name`) passed to the cli tool used should be++```+haskell-http-client+```++### Unsupported OpenAPI Features++* Model Inheritance++This is beta software; other cases may not be supported.++### Codegen "additional properties" parameters++These options allow some customization of the code generation process.++**haskell-http-client additional properties:**++| OPTION                          | DESCRIPTION                                                                                                                   | DEFAULT  | ACTUAL                                |+|---------------------------------|-------------------------------------------------------------------------------------------------------------------------------|----------|---------------------------------------|+| allowFromJsonNulls              | allow JSON Null during model decoding from JSON                                                                               | true     | true              |+| allowNonUniqueOperationIds      | allow *different* API modules to contain the same operationId. Each API must be imported qualified                            | false    | false    |+| allowToJsonNulls                | allow emitting JSON Null during model encoding to JSON                                                                        | false    | false                |+| baseModule                      | Set the base module namespace                                                                                                 |          | Httpstan                      |+| cabalPackage                    | Set the cabal package name, which consists of one or more alphanumeric words separated by hyphens                             |          | httpstan                    |+| cabalVersion                    | Set the cabal version number, consisting of a sequence of one or more integers separated by dots                              | 0.1.0.0  | 0.1.0.0                    |+| customTestInstanceModule        | test module used to provide typeclass instances for types not known by the generator                                          |          |         |+| configType                      | Set the name of the type used for configuration                                                                               |          | HttpstanConfig                      |+| dateFormat                      | format string used to parse/render a date                                                                                     | %Y-%m-%d | %Y-%m-%d                      |+| dateTimeFormat                  | format string used to parse/render a datetime. (Defaults to [formatISO8601Millis][1] when not provided)                       |          |                   |+| dateTimeParseFormat             | overrides the format string used to parse a datetime                                                                          |          |              |+| generateEnums                   | Generate specific datatypes for OpenAPI enums                                                                                 | true     | true                   |+| generateFormUrlEncodedInstances | Generate FromForm/ToForm instances for models used by x-www-form-urlencoded operations (model fields must be primitive types) | true     | true |+| generateLenses                  | Generate Lens optics for Models                                                                                               | true     | true                  |+| generateModelConstructors       | Generate smart constructors (only supply required fields) for models                                                          | true     | true       |+| inlineMimeTypes                 | Inline (hardcode) the content-type and accept parameters on operations, when there is only 1 option                           | true     | true                 |+| modelDeriving                   | Additional classes to include in the deriving() clause of Models                                                              |          |                    |+| requestType                     | Set the name of the type used to generate requests                                                                            |          | HttpstanRequest                     |+| strictFields                    | Add strictness annotations to all model fields                                                                                | true     | true                  |+| useKatip                        | Sets the default value for the UseKatip cabal flag. If true, the katip package provides logging instead of monad-logger       | true     | true                      |+| queryExtraUnreserved            | Configures additional querystring characters which must not be URI encoded, e.g. '+' or ':'                                   |          |           |++[1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis++An example setting _dateTimeFormat_ and _strictFields_:++```+java -jar openapi-generator-cli.jar generate -i petstore.yaml -g haskell-http-client -o output/haskell-http-client --additional-properties=dateTimeFormat="%Y-%m-%dT%H:%M:%S%Q%z" --additional-properties=strictFields=false+```++View the full list of Codegen "config option" parameters with the command:++```+java -jar openapi-generator-cli.jar config-help -g haskell-http-client+```++## Usage Notes++### Example Petstore Haddock documentation++An example of the generated haddock documentation targeting the server http://petstore.swagger.io/ (Petstore) can be found [here][2]++[2]: https://hackage.haskell.org/package/swagger-petstore++### Example Petstore App++An example application using the auto-generated haskell-http-client bindings for the server http://petstore.swagger.io/ can be found [here][3]++[3]: https://github.com/openapitools/openapi-generator/tree/master/samples/client/petstore/haskell-http-client/example-app++This library is intended to be imported qualified.++### Modules++| MODULE              | NOTES                                               |+| ------------------- | --------------------------------------------------- |+| Httpstan.Client    | use the "dispatch" functions to send requests       |+| Httpstan.Core      | core functions, config and request types            |+| Httpstan.API       | construct api requests                              |+| Httpstan.Model     | describes api models                                |+| Httpstan.MimeTypes | encoding/decoding MIME types (content-types/accept) |+| Httpstan.ModelLens | lenses for model fields                             |+| Httpstan.Logging   | logging functions and utils                         |+++### MimeTypes++This library adds type safety around what OpenAPI specifies as+Produces and Consumes for each Operation (e.g. the list of MIME types an+Operation can Produce (using 'accept' headers) and Consume (using 'content-type' headers).++For example, if there is an Operation named _addFoo_, there will be a+data type generated named _AddFoo_ (note the capitalization), which+describes additional constraints and actions on the _addFoo_ operation+via its typeclass instances. These typeclass instances can be viewed+in GHCi or via the Haddocks.++* required parameters are included as function arguments to _addFoo_+* optional non-body parameters are included by using  `applyOptionalParam`+* optional body parameters are set by using  `setBodyParam`++Example code generated for pretend _addFoo_ operation:++```haskell+data AddFoo+instance Consumes AddFoo MimeJSON+instance Produces AddFoo MimeJSON+instance Produces AddFoo MimeXML+instance HasBodyParam AddFoo FooModel+instance HasOptionalParam AddFoo FooName+instance HasOptionalParam AddFoo FooId+```++this would indicate that:++* the _addFoo_ operation can consume JSON+* the _addFoo_ operation produces JSON or XML, depending on the argument passed to the dispatch function+* the _addFoo_ operation can set it's body param of _FooModel_ via `setBodyParam`+* the _addFoo_ operation can set 2 different optional parameters via `applyOptionalParam`++If the OpenAPI spec doesn't declare it can accept or produce a certain+MIME type for a given Operation, you should either add a Produces or+Consumes instance for the desired MIME types (assuming the server+supports it), use `dispatchLbsUnsafe` or modify the OpenAPI spec and+run the generator again.++New MIME type instances can be added via MimeType/MimeRender/MimeUnrender++Only JSON instances are generated by default, and in some case+x-www-form-urlencoded instances (FromFrom, ToForm) will also be+generated if the model fields are primitive types, and there are+Operations using x-www-form-urlencoded which use those models.++### Authentication++A haskell data type will be generated for each OpenAPI authentication type.++If for example the AuthMethod `AuthOAuthFoo` is generated for OAuth operations, then+`addAuthMethod` should be used to add the AuthMethod config.++When a request is dispatched, if a matching auth method is found in+the config, it will be applied to the request.++### Example++```haskell+mgr <- newManager defaultManagerSettings+config0 <- withStdoutLogging =<< newConfig+let config = config0+    `addAuthMethod` AuthOAuthFoo "secret-key"++let addFooRequest =+  addFoo+    (ContentType MimeJSON)+    (Accept MimeXML)+    (ParamBar paramBar)+    (ParamQux paramQux)+    modelBaz+  `applyOptionalParam` FooId 1+  `applyOptionalParam` FooName "name"+  `setHeader` [("qux_header","xxyy")]+addFooResult <- dispatchMime mgr config addFooRequest+```++See the example app and the haddocks for details.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ httpstan.cabal view
@@ -0,0 +1,117 @@+name:           httpstan+version:        0.2.0.0+synopsis:       Auto-generated httpstan API Client+description:    .+                Client library for calling the httpstan API based on http-client.+                .+                host: localhost+                .+                base path: http://localhost+                .+                httpstan API version: 4.10.0+                .+                OpenAPI version: 3.0.1+                .+category:       Statistics+homepage:       https://github.com/jmcarthur/httpstan-hs+author:         Jake McArthur+maintainer:     Jake.McArthur@email.com+copyright:      2023 - Jake McArthur+license:        BSD3+license-files:  LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md+    openapi.yaml++source-repository head+    type: git+    location: git@github.com:jmcarthur/httpstan-hs.git++Flag UseKatip+  Description: Use the katip package to provide logging (if false, use the default monad-logger package)+  Default:     True+  Manual:      True++library+  hs-source-dirs:+      lib+  ghc-options: -Wall -funbox-strict-fields+  build-depends:+      aeson >=1.0 && <3.0+    , base >=4.7 && <5.0+    , base64-bytestring >1.0 && <2.0+    , bytestring >= 0.11.4 && < 0.12+    , case-insensitive >= 1.2.1 && < 1.3+    , containers >=0.5.0.0 && <0.8+    , deepseq >= 1.4 && <1.6+    , exceptions >= 0.10.4 && < 0.11+    , http-api-data >= 0.3.4 && <0.5+    , http-client >=0.5 && <0.8+    , http-client-tls >= 0.3.6 && < 0.4+    , http-media >= 0.4 && < 0.9+    , http-types >=0.8 && <0.13+    , iso8601-time >=0.1.3 && <0.2.0+    , microlens >= 0.4.13 && < 0.5+    , mtl >= 2.2.2 && < 2.3+    , network >=2.6.2 && <3.9+    , random >= 1.2.1 && < 1.3+    , safe-exceptions <0.2+    , text >=0.11 && <1.3+    , time >= 1.11.1 && < 1.12+    , transformers >= 0.5.6 && < 0.6+    , unordered-containers >= 0.2.19 && < 0.3+    , vector >=0.10.9 && <0.13++  other-modules:+      Paths_httpstan+  exposed-modules:+      Httpstan+      Httpstan.API+      Httpstan.API.ApiDefault+      Httpstan.Client+      Httpstan.Core+      Httpstan.Logging+      Httpstan.MimeTypes+      Httpstan.Model+      Httpstan.ModelLens+  default-language: Haskell2010++  if flag(UseKatip)+      build-depends: katip >=0.8 && < 1.0+      other-modules: Httpstan.LoggingKatip+      cpp-options: -DUSE_KATIP+  else+      build-depends: monad-logger >=0.3 && <0.4+      other-modules: Httpstan.LoggingMonadLogger+      cpp-options: -DUSE_MONAD_LOGGER++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Test.hs+  hs-source-dirs:+      tests+  ghc-options: -Wall -fno-warn-orphans+  build-depends:+      httpstan+    , QuickCheck+    , aeson+    , base >=4.7 && <5.0+    , bytestring >=0.10.0+    , containers+    , hspec >=1.8+    , iso8601-time+    , mtl >=2.2.1+    , semigroups+    , text+    , time+    , transformers >=0.4.0.0+    , unordered-containers+    , vector+  other-modules:+      ApproxEq+      Instances+      PropMime+  default-language: Haskell2010
+ lib/Httpstan.hs view
@@ -0,0 +1,31 @@+{-+   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+-}++module Httpstan+  (  module Httpstan.API+  , module Httpstan.Client+  , module Httpstan.Core+  , module Httpstan.Logging+  , module Httpstan.MimeTypes+  , module Httpstan.Model+  , module Httpstan.ModelLens+  ) where++import Httpstan.API+import Httpstan.Client+import Httpstan.Core+import Httpstan.Logging+import Httpstan.MimeTypes+import Httpstan.Model+import Httpstan.ModelLens
+ lib/Httpstan/API.hs view
@@ -0,0 +1,19 @@+{-+   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.API+-}++module Httpstan.API+  ( module Httpstan.API.ApiDefault+  ) where++import Httpstan.API.ApiDefault
+ lib/Httpstan/API/ApiDefault.hs view
@@ -0,0 +1,360 @@+{-+   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.API.ApiDefault+-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-imports #-}++module Httpstan.API.ApiDefault where++import Httpstan.Core+import Httpstan.MimeTypes+import Httpstan.Model as M++import qualified Data.Aeson as A+import qualified Data.ByteString as B+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.Map as Map+import qualified Data.Maybe as P+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.Set as Set+import qualified Data.String as P+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Time as TI+import qualified Network.HTTP.Client.MultipartFormData as NH+import qualified Network.HTTP.Media as ME+import qualified Network.HTTP.Types as NH+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Data.Text (Text)+import GHC.Base ((<|>))++import Prelude ((==),(/=),($), (.),(<$>),(<*>),(>>=),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)+import qualified Prelude as P++-- * Operations+++-- ** Default++-- *** v1HealthGet++-- | @GET \/v1\/health@+-- +-- Check if service is running.+-- +v1HealthGet+  :: HttpstanRequest V1HealthGet MimeNoContent NoContent MimeNoContent+v1HealthGet =+  _mkRequest "GET" ["/v1/health"]++data V1HealthGet  +instance Produces V1HealthGet MimeNoContent+++-- *** v1ModelsGet++-- | @GET \/v1\/models@+-- +-- List cached models.+-- +v1ModelsGet+  :: HttpstanRequest V1ModelsGet MimeNoContent V1ModelsGet200Response MimeJSON+v1ModelsGet =+  _mkRequest "GET" ["/v1/models"]++data V1ModelsGet  +-- | @application/json@+instance Produces V1ModelsGet MimeJSON+++-- *** v1ModelsModelIdDelete++-- | @DELETE \/v1\/models\/{model_id}@+-- +-- Delete a model and any associated fits.+-- +-- Delete a model which has been saved in the cache.+-- +v1ModelsModelIdDelete+  :: ModelId -- ^ "modelId" -  ID of Stan model+  -> HttpstanRequest V1ModelsModelIdDelete MimeNoContent NoContent MimeNoContent+v1ModelsModelIdDelete (ModelId modelId) =+  _mkRequest "DELETE" ["/v1/models/",toPath modelId]++data V1ModelsModelIdDelete  +instance Produces V1ModelsModelIdDelete MimeNoContent+++-- *** v1ModelsModelIdFitsFitIdDelete++-- | @DELETE \/v1\/models\/{model_id}\/fits\/{fit_id}@+-- +-- Delete a fit.+-- +-- Delete a fit which has been saved in the cache.+-- +v1ModelsModelIdFitsFitIdDelete+  :: ModelId -- ^ "modelId" -  ID of Stan model associated with the fit.+  -> FitId -- ^ "fitId" -  ID of fit to be deleted.+  -> HttpstanRequest V1ModelsModelIdFitsFitIdDelete MimeNoContent NoContent MimeNoContent+v1ModelsModelIdFitsFitIdDelete (ModelId modelId) (FitId fitId) =+  _mkRequest "DELETE" ["/v1/models/",toPath modelId,"/fits/",toPath fitId]++data V1ModelsModelIdFitsFitIdDelete  +instance Produces V1ModelsModelIdFitsFitIdDelete MimeNoContent+++-- *** v1ModelsModelIdFitsFitIdGet++-- | @GET \/v1\/models\/{model_id}\/fits\/{fit_id}@+-- +-- Get results returned by a function.+-- +-- Result (draws, logger messages) from calling a function defined in stan::services.+-- +v1ModelsModelIdFitsFitIdGet+  :: ModelId -- ^ "modelId" -  ID of Stan model associated with the result+  -> FitId -- ^ "fitId" -  ID of Stan result (\"fit\") desired+  -> HttpstanRequest V1ModelsModelIdFitsFitIdGet MimeNoContent NoContent MimeNoContent+v1ModelsModelIdFitsFitIdGet (ModelId modelId) (FitId fitId) =+  _mkRequest "GET" ["/v1/models/",toPath modelId,"/fits/",toPath fitId]++data V1ModelsModelIdFitsFitIdGet  +instance Produces V1ModelsModelIdFitsFitIdGet MimeNoContent+++-- *** v1ModelsModelIdFitsPost++-- | @POST \/v1\/models\/{model_id}\/fits@+-- +-- Call function defined in stan::services.+-- +-- A request to this endpoint starts a long-running operation. Users can retrieve information about the status of the operation by making a GET request to the operations resource endpoint. When the operation is `done`, the \"fit\" may be downloaded. (A \"fit\" collects all logger and writer messages from Stan.) ``function`` indicates the name of the ``stan::services function`` which should be called given the Stan model associated with the id ``model_id``. For example, if sampling using ``stan::services::sample::hmc_nuts_diag_e_adapt`` then ``function`` is the full function name ``stan::services::sample::hmc_nuts_diag_e_adapt``.  Sampler parameters which are not supplied will be given default values taken from CmdStan.  For example, if ``stan::services::sample::hmc_nuts_diag_e_adapt`` is the function called and the parameter ``num_samples`` is not specified, the value 1000 will be used. For a full list of default values consult the CmdStan documentation.+-- +v1ModelsModelIdFitsPost+  :: (Consumes V1ModelsModelIdFitsPost MimeJSON, MimeRender MimeJSON CreateFitRequest)+  => CreateFitRequest -- ^ "body" -  Full stan::services function name and associated arguments to call with Stan model.+  -> ModelId -- ^ "modelId" -  ID of Stan model to use+  -> HttpstanRequest V1ModelsModelIdFitsPost MimeJSON Fit MimeJSON+v1ModelsModelIdFitsPost body (ModelId modelId) =+  _mkRequest "POST" ["/v1/models/",toPath modelId,"/fits"]+    `setBodyParam` body++data V1ModelsModelIdFitsPost ++-- | /Body Param/ "body" - Full stan::services function name and associated arguments to call with Stan model.+instance HasBodyParam V1ModelsModelIdFitsPost CreateFitRequest ++-- | @application/json@+instance Consumes V1ModelsModelIdFitsPost MimeJSON++-- | @application/json@+instance Produces V1ModelsModelIdFitsPost MimeJSON+++-- *** v1ModelsModelIdLogProbGradPost++-- | @POST \/v1\/models\/{model_id}\/log_prob_grad@+-- +-- Return the gradient of the log posterior evaluated at the unconstrained parameters.+-- +-- Returns the output of Stan C++ `stan::model::log_prob_grad`.+-- +v1ModelsModelIdLogProbGradPost+  :: (Consumes V1ModelsModelIdLogProbGradPost MimeJSON)+  => ModelId -- ^ "modelId" -  ID of Stan model to use+  -> HttpstanRequest V1ModelsModelIdLogProbGradPost MimeJSON V1ModelsModelIdLogProbGradPost200Response MimeJSON+v1ModelsModelIdLogProbGradPost (ModelId modelId) =+  _mkRequest "POST" ["/v1/models/",toPath modelId,"/log_prob_grad"]++data V1ModelsModelIdLogProbGradPost ++-- | /Body Param/ "adjust_transform" - Boolean to control whether we apply a Jacobian adjust transform.+instance HasBodyParam V1ModelsModelIdLogProbGradPost AdjustTransform ++-- | @application/json@+instance Consumes V1ModelsModelIdLogProbGradPost MimeJSON++-- | @application/json@+instance Produces V1ModelsModelIdLogProbGradPost MimeJSON+++-- *** v1ModelsModelIdLogProbPost++-- | @POST \/v1\/models\/{model_id}\/log_prob@+-- +-- Return the log probability of the unconstrained parameters.+-- +-- Returns the output of Stan C++ ``log_prob`` model class method.+-- +v1ModelsModelIdLogProbPost+  :: (Consumes V1ModelsModelIdLogProbPost MimeJSON)+  => ModelId -- ^ "modelId" -  ID of Stan model to use+  -> HttpstanRequest V1ModelsModelIdLogProbPost MimeJSON V1ModelsModelIdLogProbPost200Response MimeJSON+v1ModelsModelIdLogProbPost (ModelId modelId) =+  _mkRequest "POST" ["/v1/models/",toPath modelId,"/log_prob"]++data V1ModelsModelIdLogProbPost ++-- | /Body Param/ "adjust_transform" - Boolean to control whether we apply a Jacobian adjust transform.+instance HasBodyParam V1ModelsModelIdLogProbPost AdjustTransform ++-- | @application/json@+instance Consumes V1ModelsModelIdLogProbPost MimeJSON++-- | @application/json@+instance Produces V1ModelsModelIdLogProbPost MimeJSON+++-- *** v1ModelsModelIdParamsPost++-- | @POST \/v1\/models\/{model_id}\/params@+-- +-- Get parameter names and dimensions.+-- +-- Returns the output of Stan C++ model class methods: ``constrained_param_names``, ``get_param_names`` and ``get_dims``.+-- +v1ModelsModelIdParamsPost+  :: (Consumes V1ModelsModelIdParamsPost MimeJSON, MimeRender MimeJSON ParamData)+  => ParamData -- ^ "_data" -  Data for Stan Model. Needed to calculate param names and dimensions.+  -> ModelId -- ^ "modelId" -  ID of Stan model to use+  -> HttpstanRequest V1ModelsModelIdParamsPost MimeJSON V1ModelsModelIdParamsPost200Response MimeJSON+v1ModelsModelIdParamsPost _data (ModelId modelId) =+  _mkRequest "POST" ["/v1/models/",toPath modelId,"/params"]+    `setBodyParam` _data++data V1ModelsModelIdParamsPost ++-- | /Body Param/ "data" - Data for Stan Model. Needed to calculate param names and dimensions.+instance HasBodyParam V1ModelsModelIdParamsPost ParamData ++-- | @application/json@+instance Consumes V1ModelsModelIdParamsPost MimeJSON++-- | @application/json@+instance Produces V1ModelsModelIdParamsPost MimeJSON+++-- *** v1ModelsModelIdTransformInitsPost++-- | @POST \/v1\/models\/{model_id}\/transform_inits@+-- +-- Return a sequence of unconstrained parameters.+-- +-- Returns the output of Stan C++ ``transform_inits`` model class method.+-- +v1ModelsModelIdTransformInitsPost+  :: (Consumes V1ModelsModelIdTransformInitsPost MimeJSON, MimeRender MimeJSON ConstrainedParameters)+  => ConstrainedParameters -- ^ "constrainedParameters" -  Constrained parameter values and their specified context+  -> ModelId -- ^ "modelId" -  ID of Stan model to use+  -> HttpstanRequest V1ModelsModelIdTransformInitsPost MimeJSON V1ModelsModelIdTransformInitsPost200Response MimeJSON+v1ModelsModelIdTransformInitsPost constrainedParameters (ModelId modelId) =+  _mkRequest "POST" ["/v1/models/",toPath modelId,"/transform_inits"]+    `setBodyParam` constrainedParameters++data V1ModelsModelIdTransformInitsPost ++-- | /Body Param/ "constrained_parameters" - Constrained parameter values and their specified context+instance HasBodyParam V1ModelsModelIdTransformInitsPost ConstrainedParameters ++-- | @application/json@+instance Consumes V1ModelsModelIdTransformInitsPost MimeJSON++-- | @application/json@+instance Produces V1ModelsModelIdTransformInitsPost MimeJSON+++-- *** v1ModelsModelIdWriteArrayPost++-- | @POST \/v1\/models\/{model_id}\/write_array@+-- +-- Return a sequence of constrained parameters.+-- +-- Returns the output of Stan C++ ``write_array`` model class method.+-- +v1ModelsModelIdWriteArrayPost+  :: (Consumes V1ModelsModelIdWriteArrayPost MimeJSON, MimeRender MimeJSON IncludeGqs)+  => IncludeGqs -- ^ "includeGqs" -  Boolean to control whether we include generated quantities.+  -> ModelId -- ^ "modelId" -  ID of Stan model to use+  -> HttpstanRequest V1ModelsModelIdWriteArrayPost MimeJSON V1ModelsModelIdWriteArrayPost200Response MimeJSON+v1ModelsModelIdWriteArrayPost includeGqs (ModelId modelId) =+  _mkRequest "POST" ["/v1/models/",toPath modelId,"/write_array"]+    `setBodyParam` includeGqs++data V1ModelsModelIdWriteArrayPost ++-- | /Body Param/ "include_gqs" - Boolean to control whether we include generated quantities.+instance HasBodyParam V1ModelsModelIdWriteArrayPost IncludeGqs ++-- | @application/json@+instance Consumes V1ModelsModelIdWriteArrayPost MimeJSON++-- | @application/json@+instance Produces V1ModelsModelIdWriteArrayPost MimeJSON+++-- *** v1ModelsPost++-- | @POST \/v1\/models@+-- +-- Compile a Stan model+-- +v1ModelsPost+  :: (Consumes V1ModelsPost MimeJSON, MimeRender MimeJSON CreateModelRequest)+  => CreateModelRequest -- ^ "body" -  Stan program code to compile+  -> HttpstanRequest V1ModelsPost MimeJSON Model MimeJSON+v1ModelsPost body =+  _mkRequest "POST" ["/v1/models"]+    `setBodyParam` body++data V1ModelsPost ++-- | /Body Param/ "body" - Stan program code to compile+instance HasBodyParam V1ModelsPost CreateModelRequest ++-- | @application/json@+instance Consumes V1ModelsPost MimeJSON++-- | @application/json@+instance Produces V1ModelsPost MimeJSON+++-- *** v1OperationsOperationIdGet++-- | @GET \/v1\/operations\/{operation_id}@+-- +-- Get Operation details.+-- +-- Return Operation details. Details about an Operation include whether or not the operation is `done` and information about the progress of sampling.+-- +v1OperationsOperationIdGet+  :: OperationId -- ^ "operationId" -  ID of Operation+  -> HttpstanRequest V1OperationsOperationIdGet MimeNoContent Operation MimeJSON+v1OperationsOperationIdGet (OperationId operationId) =+  _mkRequest "GET" ["/v1/operations/",toPath operationId]++data V1OperationsOperationIdGet  +-- | @application/json@+instance Produces V1OperationsOperationIdGet MimeJSON+
+ lib/Httpstan/Client.hs view
@@ -0,0 +1,223 @@+{-+   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.Client+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}++module Httpstan.Client where++import Httpstan.Core+import Httpstan.Logging+import Httpstan.MimeTypes++import qualified Control.Exception.Safe as E+import qualified Control.Monad.IO.Class as P+import qualified Control.Monad as P+import qualified Data.Aeson.Types as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BCL+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Client as NH+import qualified Network.HTTP.Client.MultipartFormData as NH+import qualified Network.HTTP.Types as NH+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Data.Function ((&))+import Data.Monoid ((<>))+import Data.Text (Text)+import GHC.Exts (IsString(..))++-- * Dispatch++-- ** Lbs++-- | send a request returning the raw http response+dispatchLbs+  :: (Produces req accept, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> HttpstanConfig -- ^ config+  -> HttpstanRequest req contentType res accept -- ^ request+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchLbs manager config request  = do+  initReq <- _toInitRequest config request+  dispatchInitUnsafe manager config initReq++-- ** Mime++-- | pair of decoded http body and http response+data MimeResult res =+  MimeResult { mimeResult :: Either MimeError res -- ^ decoded http body+             , mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response+             }+  deriving (Show, Functor, Foldable, Traversable)++-- | pair of unrender/parser error and http response+data MimeError =+  MimeError {+    mimeError :: String -- ^ unrender/parser error+  , mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response+  } deriving (Show)++-- | send a request returning the 'MimeResult'+dispatchMime+  :: forall req contentType res accept. (Produces req accept, MimeUnrender accept res, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> HttpstanConfig -- ^ config+  -> HttpstanRequest req contentType res accept -- ^ request+  -> IO (MimeResult res) -- ^ response+dispatchMime manager config request = do+  httpResponse <- dispatchLbs manager config request+  let statusCode = NH.statusCode . NH.responseStatus $ httpResponse+  parsedResult <-+    runConfigLogWithExceptions "Client" config $+    do if (statusCode >= 400 && statusCode < 600)+         then do+           let s = "error statusCode: " ++ show statusCode+           _log "Client" levelError (T.pack s)+           pure (Left (MimeError s httpResponse))+         else case mimeUnrender (P.Proxy :: P.Proxy accept) (NH.responseBody httpResponse) of+           Left s -> do+             _log "Client" levelError (T.pack s)+             pure (Left (MimeError s httpResponse))+           Right r -> pure (Right r)+  return (MimeResult parsedResult httpResponse)++-- | like 'dispatchMime', but only returns the decoded http body+dispatchMime'+  :: (Produces req accept, MimeUnrender accept res, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> HttpstanConfig -- ^ config+  -> HttpstanRequest req contentType res accept -- ^ request+  -> IO (Either MimeError res) -- ^ response+dispatchMime' manager config request  = do+    MimeResult parsedResult _ <- dispatchMime manager config request+    return parsedResult++-- ** Unsafe++-- | like 'dispatchReqLbs', but does not validate the operation is a 'Producer' of the "accept" 'MimeType'.  (Useful if the server's response is undocumented)+dispatchLbsUnsafe+  :: (MimeType accept, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> HttpstanConfig -- ^ config+  -> HttpstanRequest req contentType res accept -- ^ request+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchLbsUnsafe manager config request  = do+  initReq <- _toInitRequest config request+  dispatchInitUnsafe manager config initReq++-- | dispatch an InitRequest+dispatchInitUnsafe+  :: NH.Manager -- ^ http-client Connection manager+  -> HttpstanConfig -- ^ config+  -> InitRequest req contentType res accept -- ^ init request+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchInitUnsafe manager config (InitRequest req) = do+  runConfigLogWithExceptions src config $+    do _log src levelInfo requestLogMsg+       _log src levelDebug requestDbgLogMsg+       res <- P.liftIO $ NH.httpLbs req manager+       _log src levelInfo (responseLogMsg res)+       _log src levelDebug ((T.pack . show) res)+       return res+  where+    src = "Client"+    endpoint =+      T.pack $+      BC.unpack $+      NH.method req <> " " <> NH.host req <> NH.path req <> NH.queryString req+    requestLogMsg = "REQ:" <> endpoint+    requestDbgLogMsg =+      "Headers=" <> (T.pack . show) (NH.requestHeaders req) <> " Body=" <>+      (case NH.requestBody req of+         NH.RequestBodyLBS xs -> T.decodeUtf8 (BL.toStrict xs)+         _ -> "<RequestBody>")+    responseStatusCode = (T.pack . show) . NH.statusCode . NH.responseStatus+    responseLogMsg res =+      "RES:statusCode=" <> responseStatusCode res <> " (" <> endpoint <> ")"++-- * InitRequest++-- | wraps an http-client 'Request' with request/response type parameters+newtype InitRequest req contentType res accept = InitRequest+  { unInitRequest :: NH.Request+  } deriving (Show)++-- |  Build an http-client 'Request' record from the supplied config and request+_toInitRequest+  :: (MimeType accept, MimeType contentType)+  => HttpstanConfig -- ^ config+  -> HttpstanRequest req contentType res accept -- ^ request+  -> IO (InitRequest req contentType res accept) -- ^ initialized request+_toInitRequest config req0  =+  runConfigLogWithExceptions "Client" config $ do+    parsedReq <- P.liftIO $ NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (rUrlPath req0))+    req1 <- P.liftIO $ _applyAuthMethods req0 config+    P.when+        (configValidateAuthMethods config && (not . null . rAuthTypes) req1)+        (E.throw $ AuthMethodException $ "AuthMethod not configured: " <> (show . head . rAuthTypes) req1)+    let req2 = req1 & _setContentTypeHeader & _setAcceptHeader+        params = rParams req2+        reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders params+        reqQuery = let query = paramsQuery params+                       queryExtraUnreserved = configQueryExtraUnreserved config+                   in if B.null queryExtraUnreserved+                        then NH.renderQuery True query+                        else NH.renderQueryPartialEscape True (toPartialEscapeQuery queryExtraUnreserved query)+        pReq = parsedReq { NH.method = rMethod req2+                        , NH.requestHeaders = reqHeaders+                        , NH.queryString = reqQuery+                        }+    outReq <- case paramsBody params of+        ParamBodyNone -> pure (pReq { NH.requestBody = mempty })+        ParamBodyB bs -> pure (pReq { NH.requestBody = NH.RequestBodyBS bs })+        ParamBodyBL bl -> pure (pReq { NH.requestBody = NH.RequestBodyLBS bl })+        ParamBodyFormUrlEncoded form -> pure (pReq { NH.requestBody = NH.RequestBodyLBS (WH.urlEncodeForm form) })+        ParamBodyMultipartFormData parts -> NH.formDataBody parts pReq++    pure (InitRequest outReq)++-- | modify the underlying Request+modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept+modifyInitRequest (InitRequest req) f = InitRequest (f req)++-- | modify the underlying Request (monadic)+modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept)+modifyInitRequestM (InitRequest req) f = fmap InitRequest (f req)++-- ** Logging++-- | Run a block using the configured logger instance+runConfigLog+  :: P.MonadIO m+  => HttpstanConfig -> LogExec m a+runConfigLog config = configLogExecWithContext config (configLogContext config)++-- | Run a block using the configured logger instance (logs exceptions)+runConfigLogWithExceptions+  :: (E.MonadCatch m, P.MonadIO m)+  => T.Text -> HttpstanConfig -> LogExec m a+runConfigLogWithExceptions src config = runConfigLog config . logExceptions src
+ lib/Httpstan/Core.hs view
@@ -0,0 +1,581 @@+{-+   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.Core+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-imports #-}++module Httpstan.Core where++import Httpstan.MimeTypes+import Httpstan.Logging++import qualified Control.Arrow as P (left)+import qualified Control.DeepSeq as NF+import qualified Control.Exception.Safe as E+import qualified Data.Aeson as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64.Lazy as BL64+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BCL+import qualified Data.CaseInsensitive as CI+import qualified Data.Data as P (Data, Typeable, TypeRep, typeRep)+import qualified Data.Foldable as P+import qualified Data.Ix as P+import qualified Data.Kind as K (Type)+import qualified Data.Maybe as P+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Time as TI+import qualified Data.Time.ISO8601 as TI+import qualified GHC.Base as P (Alternative)+import qualified Lens.Micro as L+import qualified Network.HTTP.Client.MultipartFormData as NH+import qualified Network.HTTP.Types as NH+import qualified Prelude as P+import qualified Text.Printf as T+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Control.Applicative ((<|>))+import Control.Applicative (Alternative)+import Control.Monad.Fail (MonadFail)+import Data.Function ((&))+import Data.Foldable(foldlM)+import Data.Monoid ((<>))+import Data.Text (Text)+import Prelude (($), (.), (&&), (<$>), (<*>), Maybe(..), Bool(..), Char, String, fmap, mempty, pure, return, show, IO, Monad, Functor, maybe)++-- * HttpstanConfig++-- |+data HttpstanConfig = HttpstanConfig+  { configHost  :: BCL.ByteString -- ^ host supplied in the Request+  , configUserAgent :: Text -- ^ user-agent supplied in the Request+  , configLogExecWithContext :: LogExecWithContext -- ^ Run a block using a Logger instance+  , configLogContext :: LogContext -- ^ Configures the logger+  , configAuthMethods :: [AnyAuthMethod] -- ^ List of configured auth methods+  , configValidateAuthMethods :: Bool -- ^ throw exceptions if auth methods are not configured+  , configQueryExtraUnreserved :: B.ByteString -- ^ Configures additional querystring characters which must not be URI encoded, e.g. '+' or ':'+  }++-- | display the config+instance P.Show HttpstanConfig where+  show c =+    T.printf+      "{ configHost = %v, configUserAgent = %v, ..}"+      (show (configHost c))+      (show (configUserAgent c))++-- | constructs a default HttpstanConfig+--+-- configHost:+--+-- @http://localhost@+--+-- configUserAgent:+--+-- @"httpstan/0.1.0.0"@+--+newConfig :: IO HttpstanConfig+newConfig = do+    logCxt <- initLogContext+    return $ HttpstanConfig+        { configHost = "http://localhost"+        , configUserAgent = "httpstan/0.1.0.0"+        , configLogExecWithContext = runDefaultLogExecWithContext+        , configLogContext = logCxt+        , configAuthMethods = []+        , configValidateAuthMethods = True+        , configQueryExtraUnreserved = ""+        }++-- | updates config use AuthMethod on matching requests+addAuthMethod :: AuthMethod auth => HttpstanConfig -> auth -> HttpstanConfig+addAuthMethod config@HttpstanConfig {configAuthMethods = as} a =+  config { configAuthMethods = AnyAuthMethod a : as}++-- | updates the config to use stdout logging+withStdoutLogging :: HttpstanConfig -> IO HttpstanConfig+withStdoutLogging p = do+    logCxt <- stdoutLoggingContext (configLogContext p)+    return $ p { configLogExecWithContext = stdoutLoggingExec, configLogContext = logCxt }++-- | updates the config to use stderr logging+withStderrLogging :: HttpstanConfig -> IO HttpstanConfig+withStderrLogging p = do+    logCxt <- stderrLoggingContext (configLogContext p)+    return $ p { configLogExecWithContext = stderrLoggingExec, configLogContext = logCxt }++-- | updates the config to disable logging+withNoLogging :: HttpstanConfig -> HttpstanConfig+withNoLogging p = p { configLogExecWithContext =  runNullLogExec}++-- * HttpstanRequest++-- | Represents a request.+--+--   Type Variables:+--+--   * req - request operation+--   * contentType - 'MimeType' associated with request body+--   * res - response model+--   * accept - 'MimeType' associated with response body+data HttpstanRequest req contentType res accept = HttpstanRequest+  { rMethod  :: NH.Method   -- ^ Method of HttpstanRequest+  , rUrlPath :: [BCL.ByteString] -- ^ Endpoint of HttpstanRequest+  , rParams   :: Params -- ^ params of HttpstanRequest+  , rAuthTypes :: [P.TypeRep] -- ^ types of auth methods+  }+  deriving (P.Show)++-- | 'rMethod' Lens+rMethodL :: Lens_' (HttpstanRequest req contentType res accept) NH.Method+rMethodL f HttpstanRequest{..} = (\rMethod -> HttpstanRequest { rMethod, ..} ) <$> f rMethod+{-# INLINE rMethodL #-}++-- | 'rUrlPath' Lens+rUrlPathL :: Lens_' (HttpstanRequest req contentType res accept) [BCL.ByteString]+rUrlPathL f HttpstanRequest{..} = (\rUrlPath -> HttpstanRequest { rUrlPath, ..} ) <$> f rUrlPath+{-# INLINE rUrlPathL #-}++-- | 'rParams' Lens+rParamsL :: Lens_' (HttpstanRequest req contentType res accept) Params+rParamsL f HttpstanRequest{..} = (\rParams -> HttpstanRequest { rParams, ..} ) <$> f rParams+{-# INLINE rParamsL #-}++-- | 'rParams' Lens+rAuthTypesL :: Lens_' (HttpstanRequest req contentType res accept) [P.TypeRep]+rAuthTypesL f HttpstanRequest{..} = (\rAuthTypes -> HttpstanRequest { rAuthTypes, ..} ) <$> f rAuthTypes+{-# INLINE rAuthTypesL #-}++-- * HasBodyParam++-- | Designates the body parameter of a request+class HasBodyParam req param where+  setBodyParam :: forall contentType res accept. (Consumes req contentType, MimeRender contentType param) => HttpstanRequest req contentType res accept -> param -> HttpstanRequest req contentType res accept+  setBodyParam req xs =+    req `_setBodyLBS` mimeRender (P.Proxy :: P.Proxy contentType) xs & _setContentTypeHeader++-- * HasOptionalParam++-- | Designates the optional parameters of a request+class HasOptionalParam req param where+  {-# MINIMAL applyOptionalParam | (-&-) #-}++  -- | Apply an optional parameter to a request+  applyOptionalParam :: HttpstanRequest req contentType res accept -> param -> HttpstanRequest req contentType res accept+  applyOptionalParam = (-&-)+  {-# INLINE applyOptionalParam #-}++  -- | infix operator \/ alias for 'addOptionalParam'+  (-&-) :: HttpstanRequest req contentType res accept -> param -> HttpstanRequest req contentType res accept+  (-&-) = applyOptionalParam+  {-# INLINE (-&-) #-}++infixl 2 -&-++-- | Request Params+data Params = Params+  { paramsQuery :: NH.Query+  , paramsHeaders :: NH.RequestHeaders+  , paramsBody :: ParamBody+  }+  deriving (P.Show)++-- | 'paramsQuery' Lens+paramsQueryL :: Lens_' Params NH.Query+paramsQueryL f Params{..} = (\paramsQuery -> Params { paramsQuery, ..} ) <$> f paramsQuery+{-# INLINE paramsQueryL #-}++-- | 'paramsHeaders' Lens+paramsHeadersL :: Lens_' Params NH.RequestHeaders+paramsHeadersL f Params{..} = (\paramsHeaders -> Params { paramsHeaders, ..} ) <$> f paramsHeaders+{-# INLINE paramsHeadersL #-}++-- | 'paramsBody' Lens+paramsBodyL :: Lens_' Params ParamBody+paramsBodyL f Params{..} = (\paramsBody -> Params { paramsBody, ..} ) <$> f paramsBody+{-# INLINE paramsBodyL #-}++-- | Request Body+data ParamBody+  = ParamBodyNone+  | ParamBodyB B.ByteString+  | ParamBodyBL BL.ByteString+  | ParamBodyFormUrlEncoded WH.Form+  | ParamBodyMultipartFormData [NH.Part]+  deriving (P.Show)++-- ** HttpstanRequest Utils++_mkRequest :: NH.Method -- ^ Method+          -> [BCL.ByteString] -- ^ Endpoint+          -> HttpstanRequest req contentType res accept -- ^ req: Request Type, res: Response Type+_mkRequest m u = HttpstanRequest m u _mkParams []++_mkParams :: Params+_mkParams = Params [] [] ParamBodyNone++setHeader ::+     HttpstanRequest req contentType res accept+  -> [NH.Header]+  -> HttpstanRequest req contentType res accept+setHeader req header =+  req `removeHeader` P.fmap P.fst header+  & (`addHeader` header)++addHeader ::+     HttpstanRequest req contentType res accept+  -> [NH.Header]+  -> HttpstanRequest req contentType res accept+addHeader req header = L.over (rParamsL . paramsHeadersL) (header P.++) req++removeHeader :: HttpstanRequest req contentType res accept -> [NH.HeaderName] -> HttpstanRequest req contentType res accept+removeHeader req header =+  req &+  L.over+    (rParamsL . paramsHeadersL)+    (P.filter (\h -> cifst h `P.notElem` P.fmap CI.mk header))+  where+    cifst = CI.mk . P.fst+++_setContentTypeHeader :: forall req contentType res accept. MimeType contentType => HttpstanRequest req contentType res accept -> HttpstanRequest req contentType res accept+_setContentTypeHeader req =+    case mimeType (P.Proxy :: P.Proxy contentType) of+        Just m -> req `setHeader` [("content-type", BC.pack $ P.show m)]+        Nothing -> req `removeHeader` ["content-type"]++_setAcceptHeader :: forall req contentType res accept. MimeType accept => HttpstanRequest req contentType res accept -> HttpstanRequest req contentType res accept+_setAcceptHeader req =+    case mimeType (P.Proxy :: P.Proxy accept) of+        Just m -> req `setHeader` [("accept", BC.pack $ P.show m)]+        Nothing -> req `removeHeader` ["accept"]++setQuery ::+     HttpstanRequest req contentType res accept+  -> [NH.QueryItem]+  -> HttpstanRequest req contentType res accept+setQuery req query =+  req &+  L.over+    (rParamsL . paramsQueryL)+    (P.filter (\q -> cifst q `P.notElem` P.fmap cifst query)) &+  (`addQuery` query)+  where+    cifst = CI.mk . P.fst++addQuery ::+     HttpstanRequest req contentType res accept+  -> [NH.QueryItem]+  -> HttpstanRequest req contentType res accept+addQuery req query = req & L.over (rParamsL . paramsQueryL) (query P.++)++addForm :: HttpstanRequest req contentType res accept -> WH.Form -> HttpstanRequest req contentType res accept+addForm req newform =+    let form = case paramsBody (rParams req) of+            ParamBodyFormUrlEncoded _form -> _form+            _ -> mempty+    in req & L.set (rParamsL . paramsBodyL) (ParamBodyFormUrlEncoded (newform <> form))++_addMultiFormPart :: HttpstanRequest req contentType res accept -> NH.Part -> HttpstanRequest req contentType res accept+_addMultiFormPart req newpart =+    let parts = case paramsBody (rParams req) of+            ParamBodyMultipartFormData _parts -> _parts+            _ -> []+    in req & L.set (rParamsL . paramsBodyL) (ParamBodyMultipartFormData (newpart : parts))++_setBodyBS :: HttpstanRequest req contentType res accept -> B.ByteString -> HttpstanRequest req contentType res accept+_setBodyBS req body =+    req & L.set (rParamsL . paramsBodyL) (ParamBodyB body)++_setBodyLBS :: HttpstanRequest req contentType res accept -> BL.ByteString -> HttpstanRequest req contentType res accept+_setBodyLBS req body =+    req & L.set (rParamsL . paramsBodyL) (ParamBodyBL body)++_hasAuthType :: AuthMethod authMethod => HttpstanRequest req contentType res accept -> P.Proxy authMethod -> HttpstanRequest req contentType res accept+_hasAuthType req proxy =+  req & L.over rAuthTypesL (P.typeRep proxy :)++-- ** Params Utils++toPath+  :: WH.ToHttpApiData a+  => a -> BCL.ByteString+toPath = BB.toLazyByteString . WH.toEncodedUrlPiece++toHeader :: WH.ToHttpApiData a => (NH.HeaderName, a) -> [NH.Header]+toHeader x = [fmap WH.toHeader x]++toForm :: WH.ToHttpApiData v => (BC.ByteString, v) -> WH.Form+toForm (k,v) = WH.toForm [(BC.unpack k,v)]++toQuery :: WH.ToHttpApiData a => (BC.ByteString, Maybe a) -> [NH.QueryItem]+toQuery x = [(fmap . fmap) toQueryParam x]+  where toQueryParam = T.encodeUtf8 . WH.toQueryParam++toPartialEscapeQuery :: B.ByteString -> NH.Query -> NH.PartialEscapeQuery+toPartialEscapeQuery extraUnreserved query = fmap (\(k, v) -> (k, maybe [] go v)) query+  where go :: B.ByteString -> [NH.EscapeItem]+        go v = v & B.groupBy (\a b -> a `B.notElem` extraUnreserved && b `B.notElem` extraUnreserved)+                 & fmap (\xs -> if B.null xs then NH.QN xs+                                  else if B.head xs `B.elem` extraUnreserved+                                          then NH.QN xs -- Not Encoded+                                          else NH.QE xs -- Encoded+                        )++-- *** OpenAPI `CollectionFormat` Utils++-- | Determines the format of the array if type array is used.+data CollectionFormat+  = CommaSeparated -- ^ CSV format for multiple parameters.+  | SpaceSeparated -- ^ Also called "SSV"+  | TabSeparated -- ^ Also called "TSV"+  | PipeSeparated -- ^ `value1|value2|value2`+  | MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. This is valid only for parameters in "query" ('NH.Query') or "formData" ('WH.Form')++toHeaderColl :: WH.ToHttpApiData a => CollectionFormat -> (NH.HeaderName, [a]) -> [NH.Header]+toHeaderColl c xs = _toColl c toHeader xs++toFormColl :: WH.ToHttpApiData v => CollectionFormat -> (BC.ByteString, [v]) -> WH.Form+toFormColl c xs = WH.toForm $ fmap unpack $ _toColl c toHeader $ pack xs+  where+    pack (k,v) = (CI.mk k, v)+    unpack (k,v) = (BC.unpack (CI.original k), BC.unpack v)++toQueryColl :: WH.ToHttpApiData a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query+toQueryColl c xs = _toCollA c toQuery xs++_toColl :: P.Traversable f => CollectionFormat -> (f a -> [(b, BC.ByteString)]) -> f [a] -> [(b, BC.ByteString)]+_toColl c encode xs = fmap (fmap P.fromJust) (_toCollA' c fencode BC.singleton (fmap Just xs))+  where fencode = fmap (fmap Just) . encode . fmap P.fromJust+        {-# INLINE fencode #-}++_toCollA :: (P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t BC.ByteString)]) -> f (t [a]) -> [(b, t BC.ByteString)]+_toCollA c encode xs = _toCollA' c encode BC.singleton xs++_toCollA' :: (P.Monoid c, P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t c)]) -> (Char -> c) -> f (t [a]) -> [(b, t c)]+_toCollA' c encode one xs = case c of+  CommaSeparated -> go (one ',')+  SpaceSeparated -> go (one ' ')+  TabSeparated -> go (one '\t')+  PipeSeparated -> go (one '|')+  MultiParamArray -> expandList+  where+    go sep =+      [P.foldl1 (\(sk, sv) (_, v) -> (sk, (combine sep <$> sv <*> v) <|> sv <|> v)) expandList]+    combine sep x y = x <> sep <> y+    expandList = (P.concatMap encode . (P.traverse . P.traverse) P.toList) xs+    {-# INLINE go #-}+    {-# INLINE expandList #-}+    {-# INLINE combine #-}++-- * AuthMethods++-- | Provides a method to apply auth methods to requests+class P.Typeable a =>+      AuthMethod a  where+  applyAuthMethod+    :: HttpstanConfig+    -> a+    -> HttpstanRequest req contentType res accept+    -> IO (HttpstanRequest req contentType res accept)++-- | An existential wrapper for any AuthMethod+data AnyAuthMethod = forall a. AuthMethod a => AnyAuthMethod a deriving (P.Typeable)++instance AuthMethod AnyAuthMethod where applyAuthMethod config (AnyAuthMethod a) req = applyAuthMethod config a req++-- | indicates exceptions related to AuthMethods+data AuthMethodException = AuthMethodException String deriving (P.Show, P.Typeable)++instance E.Exception AuthMethodException++-- | apply all matching AuthMethods in config to request+_applyAuthMethods+  :: HttpstanRequest req contentType res accept+  -> HttpstanConfig+  -> IO (HttpstanRequest req contentType res accept)+_applyAuthMethods req config@(HttpstanConfig {configAuthMethods = as}) =+  foldlM go req as+  where+    go r (AnyAuthMethod a) = applyAuthMethod config a r++-- * Utils++-- | Removes Null fields.  (OpenAPI-Specification 2.0 does not allow Null in JSON)+#if MIN_VERSION_aeson(2,0,0)+_omitNulls :: [(A.Key, A.Value)] -> A.Value+#else+_omitNulls :: [(Text, A.Value)] -> A.Value+#endif+_omitNulls = A.object . P.filter notNull+  where+    notNull (_, A.Null) = False+    notNull _ = True++-- | Encodes fields using WH.toQueryParam+_toFormItem :: (WH.ToHttpApiData a, Functor f) => t -> f a -> f (t, [Text])+_toFormItem name x = (name,) . (:[]) . WH.toQueryParam <$> x++-- | Collapse (Just "") to Nothing+_emptyToNothing :: Maybe String -> Maybe String+_emptyToNothing (Just "") = Nothing+_emptyToNothing x = x+{-# INLINE _emptyToNothing #-}++-- | Collapse (Just mempty) to Nothing+_memptyToNothing :: (P.Monoid a, P.Eq a) => Maybe a -> Maybe a+_memptyToNothing (Just x) | x P.== P.mempty = Nothing+_memptyToNothing x = x+{-# INLINE _memptyToNothing #-}++-- * DateTime Formatting++newtype DateTime = DateTime { unDateTime :: TI.UTCTime }+  deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)+instance A.FromJSON DateTime where+  parseJSON = A.withText "DateTime" (_readDateTime . T.unpack)+instance A.ToJSON DateTime where+  toJSON (DateTime t) = A.toJSON (_showDateTime t)+instance WH.FromHttpApiData DateTime where+  parseUrlPiece = P.maybe (P.Left "parseUrlPiece @DateTime") P.Right . _readDateTime . T.unpack+instance WH.ToHttpApiData DateTime where+  toUrlPiece (DateTime t) = T.pack (_showDateTime t)+instance P.Show DateTime where+  show (DateTime t) = _showDateTime t+instance MimeRender MimeMultipartFormData DateTime where+  mimeRender _ = mimeRenderDefaultMultipartFormData++-- | @_parseISO8601@+_readDateTime :: (MonadFail m, Alternative m) => String -> m DateTime+_readDateTime s =+  DateTime <$> _parseISO8601 s+{-# INLINE _readDateTime #-}++-- | @TI.formatISO8601Millis@+_showDateTime :: (t ~ TI.UTCTime, TI.FormatTime t) => t -> String+_showDateTime =+  TI.formatISO8601Millis+{-# INLINE _showDateTime #-}++-- | parse an ISO8601 date-time string+_parseISO8601 :: (TI.ParseTime t, MonadFail m, Alternative m) => String -> m t+_parseISO8601 t =+  P.asum $+  P.flip (TI.parseTimeM True TI.defaultTimeLocale) t <$>+  ["%FT%T%QZ", "%FT%T%Q%z", "%FT%T%Q%Z"]+{-# INLINE _parseISO8601 #-}++-- * Date Formatting++newtype Date = Date { unDate :: TI.Day }+  deriving (P.Enum,P.Eq,P.Data,P.Ord,P.Ix,NF.NFData)+instance A.FromJSON Date where+  parseJSON = A.withText "Date" (_readDate . T.unpack)+instance A.ToJSON Date where+  toJSON (Date t) = A.toJSON (_showDate t)+instance WH.FromHttpApiData Date where+  parseUrlPiece = P.maybe (P.Left "parseUrlPiece @Date") P.Right . _readDate . T.unpack+instance WH.ToHttpApiData Date where+  toUrlPiece (Date t) = T.pack (_showDate t)+instance P.Show Date where+  show (Date t) = _showDate t+instance MimeRender MimeMultipartFormData Date where+  mimeRender _ = mimeRenderDefaultMultipartFormData++-- | @TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"@+_readDate :: MonadFail m => String -> m Date+_readDate s = Date <$> TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d" s+{-# INLINE _readDate #-}++-- | @TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"@+_showDate :: TI.FormatTime t => t -> String+_showDate =+  TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"+{-# INLINE _showDate #-}++-- * Byte/Binary Formatting+++-- | base64 encoded characters+newtype ByteArray = ByteArray { unByteArray :: BL.ByteString }+  deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)++instance A.FromJSON ByteArray where+  parseJSON = A.withText "ByteArray" _readByteArray+instance A.ToJSON ByteArray where+  toJSON = A.toJSON . _showByteArray+instance WH.FromHttpApiData ByteArray where+  parseUrlPiece = P.maybe (P.Left "parseUrlPiece @ByteArray") P.Right . _readByteArray+instance WH.ToHttpApiData ByteArray where+  toUrlPiece = _showByteArray+instance P.Show ByteArray where+  show = T.unpack . _showByteArray+instance MimeRender MimeMultipartFormData ByteArray where+  mimeRender _ = mimeRenderDefaultMultipartFormData++-- | read base64 encoded characters+_readByteArray :: MonadFail m => Text -> m ByteArray+_readByteArray = P.either P.fail (pure . ByteArray) . BL64.decode . BL.fromStrict . T.encodeUtf8+{-# INLINE _readByteArray #-}++-- | show base64 encoded characters+_showByteArray :: ByteArray -> Text+_showByteArray = T.decodeUtf8 . BL.toStrict . BL64.encode . unByteArray+{-# INLINE _showByteArray #-}++-- | any sequence of octets+newtype Binary = Binary { unBinary :: BL.ByteString }+  deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)++instance A.FromJSON Binary where+  parseJSON = A.withText "Binary" _readBinaryBase64+instance A.ToJSON Binary where+  toJSON = A.toJSON . _showBinaryBase64+instance WH.FromHttpApiData Binary where+  parseUrlPiece = P.maybe (P.Left "parseUrlPiece @Binary") P.Right . _readBinaryBase64+instance WH.ToHttpApiData Binary where+  toUrlPiece = _showBinaryBase64+instance P.Show Binary where+  show = T.unpack . _showBinaryBase64+instance MimeRender MimeMultipartFormData Binary where+  mimeRender _ = unBinary++_readBinaryBase64 :: MonadFail m => Text -> m Binary+_readBinaryBase64 = P.either P.fail (pure . Binary) . BL64.decode . BL.fromStrict . T.encodeUtf8+{-# INLINE _readBinaryBase64 #-}++_showBinaryBase64 :: Binary -> Text+_showBinaryBase64 = T.decodeUtf8 . BL.toStrict . BL64.encode . unBinary+{-# INLINE _showBinaryBase64 #-}++-- * Lens Type Aliases++type Lens_' s a = Lens_ s s a a+type Lens_ s t a b = forall (f :: K.Type -> K.Type). Functor f => (a -> f b) -> s -> f t
+ lib/Httpstan/Logging.hs view
@@ -0,0 +1,33 @@+{-+   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.Logging+Logging functions+-}+{-# LANGUAGE CPP #-}++#ifdef USE_KATIP++module Httpstan.Logging+  ( module Httpstan.LoggingKatip+  ) where++import Httpstan.LoggingKatip++#else++module Httpstan.Logging+  ( module Httpstan.LoggingMonadLogger+  ) where++import Httpstan.LoggingMonadLogger++#endif
+ lib/Httpstan/LoggingKatip.hs view
@@ -0,0 +1,117 @@+{-+   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.LoggingKatip+Katip Logging functions+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Httpstan.LoggingKatip where++import qualified Control.Exception.Safe as E+import qualified Control.Monad.IO.Class as P+import qualified Control.Monad.Trans.Reader as P+import qualified Data.Text as T+import qualified Lens.Micro as L+import qualified System.IO as IO++import Data.Text (Text)+import GHC.Exts (IsString(..))++import qualified Katip as LG++-- * Type Aliases (for compatibility)++-- | Runs a Katip logging block with the Log environment+type LogExecWithContext = forall m a. P.MonadIO m =>+                                      LogContext -> LogExec m a++-- | A Katip logging block+type LogExec m a = LG.KatipT m a -> m a++-- | A Katip Log environment+type LogContext = LG.LogEnv++-- | A Katip Log severity+type LogLevel = LG.Severity++-- * default logger++-- | the default log environment+initLogContext :: IO LogContext+initLogContext = LG.initLogEnv "Httpstan" "dev"++-- | Runs a Katip logging block with the Log environment+runDefaultLogExecWithContext :: LogExecWithContext+runDefaultLogExecWithContext = LG.runKatipT++-- * stdout logger++-- | Runs a Katip logging block with the Log environment+stdoutLoggingExec :: LogExecWithContext+stdoutLoggingExec = runDefaultLogExecWithContext++-- | A Katip Log environment which targets stdout+stdoutLoggingContext :: LogContext -> IO LogContext+stdoutLoggingContext cxt = do+    handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stdout (LG.permitItem LG.InfoS) LG.V2+    LG.registerScribe "stdout" handleScribe LG.defaultScribeSettings cxt++-- * stderr logger++-- | Runs a Katip logging block with the Log environment+stderrLoggingExec :: LogExecWithContext+stderrLoggingExec = runDefaultLogExecWithContext++-- | A Katip Log environment which targets stderr+stderrLoggingContext :: LogContext -> IO LogContext+stderrLoggingContext cxt = do+    handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stderr (LG.permitItem LG.InfoS) LG.V2+    LG.registerScribe "stderr" handleScribe LG.defaultScribeSettings cxt++-- * Null logger++-- | Disables Katip logging+runNullLogExec :: LogExecWithContext+runNullLogExec le (LG.KatipT f) = P.runReaderT f (L.set LG.logEnvScribes mempty le)++-- * Log Msg++-- | Log a katip message+_log :: (Applicative m, LG.Katip m) => Text -> LogLevel -> Text -> m ()+_log src level msg = do+  LG.logMsg (fromString $ T.unpack src) level (LG.logStr msg)++-- * Log Exceptions++-- | re-throws exceptions after logging them+logExceptions+  :: (LG.Katip m, E.MonadCatch m, Applicative m)+  => Text -> m a -> m a+logExceptions src =+  E.handle+    (\(e :: E.SomeException) -> do+       _log src LG.ErrorS ((T.pack . show) e)+       E.throw e)++-- * Log Level++levelInfo :: LogLevel+levelInfo = LG.InfoS++levelError :: LogLevel+levelError = LG.ErrorS++levelDebug :: LogLevel+levelDebug = LG.DebugS
+ lib/Httpstan/LoggingMonadLogger.hs view
@@ -0,0 +1,126 @@+{-+   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.LoggingMonadLogger+monad-logger Logging functions+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Httpstan.LoggingMonadLogger where++import qualified Control.Exception.Safe as E+import qualified Control.Monad.IO.Class as P+import qualified Data.Text as T+import qualified Data.Time as TI++import Data.Text (Text)++import qualified Control.Monad.Logger as LG++-- * Type Aliases (for compatibility)++-- | Runs a monad-logger  block with the filter predicate+type LogExecWithContext = forall m a. P.MonadIO m =>+                                      LogContext -> LogExec m a++-- | A monad-logger block+type LogExec m a = LG.LoggingT m a -> m a++-- | A monad-logger filter predicate+type LogContext = LG.LogSource -> LG.LogLevel -> Bool++-- | A monad-logger log level+type LogLevel = LG.LogLevel++-- * default logger++-- | the default log environment+initLogContext :: IO LogContext+initLogContext = pure infoLevelFilter++-- | Runs a monad-logger block with the filter predicate+runDefaultLogExecWithContext :: LogExecWithContext+runDefaultLogExecWithContext = runNullLogExec++-- * stdout logger++-- | Runs a monad-logger block targeting stdout, with the filter predicate+stdoutLoggingExec :: LogExecWithContext+stdoutLoggingExec cxt = LG.runStdoutLoggingT . LG.filterLogger cxt++-- | @pure@+stdoutLoggingContext :: LogContext -> IO LogContext+stdoutLoggingContext = pure++-- * stderr logger++-- | Runs a monad-logger block targeting stderr, with the filter predicate+stderrLoggingExec :: LogExecWithContext+stderrLoggingExec cxt = LG.runStderrLoggingT . LG.filterLogger cxt++-- | @pure@+stderrLoggingContext :: LogContext -> IO LogContext+stderrLoggingContext = pure++-- * Null logger++-- | Disables monad-logger logging+runNullLogExec :: LogExecWithContext+runNullLogExec = const (`LG.runLoggingT` nullLogger)++-- | monad-logger which does nothing+nullLogger :: LG.Loc -> LG.LogSource -> LG.LogLevel -> LG.LogStr -> IO ()+nullLogger _ _ _ _ = return ()++-- * Log Msg++-- | Log a message using the current time+_log :: (P.MonadIO m, LG.MonadLogger m) => Text -> LG.LogLevel -> Text -> m ()+_log src level msg = do+  now <- P.liftIO (formatTimeLog <$> TI.getCurrentTime)+  LG.logOtherNS ("Httpstan." <> src) level ("[" <> now <> "] " <> msg)+ where+  formatTimeLog =+    T.pack . TI.formatTime TI.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Z"++-- * Log Exceptions++-- | re-throws exceptions after logging them+logExceptions+   :: (LG.MonadLogger m, E.MonadCatch m, P.MonadIO m)+   => Text -> m a -> m a+logExceptions src =+   E.handle+     (\(e :: E.SomeException) -> do+        _log src LG.LevelError ((T.pack . show) e)+        E.throw e)++-- * Log Level++levelInfo :: LogLevel+levelInfo = LG.LevelInfo++levelError :: LogLevel+levelError = LG.LevelError++levelDebug :: LogLevel+levelDebug = LG.LevelDebug++-- * Level Filter++minLevelFilter :: LG.LogLevel -> LG.LogSource -> LG.LogLevel -> Bool+minLevelFilter l _ l' = l' >= l++infoLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool+infoLevelFilter = minLevelFilter LG.LevelInfo
+ lib/Httpstan/MimeTypes.hs view
@@ -0,0 +1,203 @@+{-+   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.MimeTypes+-}++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}++module Httpstan.MimeTypes where++import qualified Control.Arrow as P (left)+import qualified Data.Aeson as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BCL+import qualified Data.Data as P (Typeable)+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.String as P+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Media as ME+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Prelude (($), (.),(<$>),(<*>),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty)+import qualified Prelude as P++-- * ContentType MimeType++data ContentType a = MimeType a => ContentType { unContentType :: a }++-- * Accept MimeType++data Accept a = MimeType a => Accept { unAccept :: a }++-- * Consumes Class++class MimeType mtype => Consumes req mtype where++-- * Produces Class++class MimeType mtype => Produces req mtype where++-- * Default Mime Types++data MimeJSON = MimeJSON deriving (P.Typeable)+data MimeXML = MimeXML deriving (P.Typeable)+data MimePlainText = MimePlainText deriving (P.Typeable)+data MimeFormUrlEncoded = MimeFormUrlEncoded deriving (P.Typeable)+data MimeMultipartFormData = MimeMultipartFormData deriving (P.Typeable)+data MimeOctetStream = MimeOctetStream deriving (P.Typeable)+data MimeNoContent = MimeNoContent deriving (P.Typeable)+data MimeAny = MimeAny deriving (P.Typeable)++-- | A type for responses without content-body.+data NoContent = NoContent+  deriving (P.Show, P.Eq, P.Typeable)+++-- * MimeType Class++class P.Typeable mtype => MimeType mtype  where+  {-# MINIMAL mimeType | mimeTypes #-}++  mimeTypes :: P.Proxy mtype -> [ME.MediaType]+  mimeTypes p =+    case mimeType p of+      Just x -> [x]+      Nothing -> []++  mimeType :: P.Proxy mtype -> Maybe ME.MediaType+  mimeType p =+    case mimeTypes p of+      [] -> Nothing+      (x:_) -> Just x++  mimeType' :: mtype -> Maybe ME.MediaType+  mimeType' _ = mimeType (P.Proxy :: P.Proxy mtype)+  mimeTypes' :: mtype -> [ME.MediaType]+  mimeTypes' _ = mimeTypes (P.Proxy :: P.Proxy mtype)++-- Default MimeType Instances++-- | @application/json; charset=utf-8@+instance MimeType MimeJSON where+  mimeType _ = Just $ P.fromString "application/json"+-- | @application/xml; charset=utf-8@+instance MimeType MimeXML where+  mimeType _ = Just $ P.fromString "application/xml"+-- | @application/x-www-form-urlencoded@+instance MimeType MimeFormUrlEncoded where+  mimeType _ = Just $ P.fromString "application/x-www-form-urlencoded"+-- | @multipart/form-data@+instance MimeType MimeMultipartFormData where+  mimeType _ = Just $ P.fromString "multipart/form-data"+-- | @text/plain; charset=utf-8@+instance MimeType MimePlainText where+  mimeType _ = Just $ P.fromString "text/plain"+-- | @application/octet-stream@+instance MimeType MimeOctetStream where+  mimeType _ = Just $ P.fromString "application/octet-stream"+-- | @"*/*"@+instance MimeType MimeAny where+  mimeType _ = Just $ P.fromString "*/*"+instance MimeType MimeNoContent where+  mimeType _ = Nothing++-- * MimeRender Class++class MimeType mtype => MimeRender mtype x where+    mimeRender  :: P.Proxy mtype -> x -> BL.ByteString+    mimeRender' :: mtype -> x -> BL.ByteString+    mimeRender' _ x = mimeRender (P.Proxy :: P.Proxy mtype) x+++mimeRenderDefaultMultipartFormData :: WH.ToHttpApiData a => a -> BL.ByteString+mimeRenderDefaultMultipartFormData = BL.fromStrict . T.encodeUtf8 . WH.toQueryParam++-- Default MimeRender Instances++-- | `A.encode`+instance A.ToJSON a => MimeRender MimeJSON a where mimeRender _ = A.encode+-- | @WH.urlEncodeAsForm@+instance WH.ToForm a => MimeRender MimeFormUrlEncoded a where mimeRender _ = WH.urlEncodeAsForm++-- | @P.id@+instance MimeRender MimePlainText BL.ByteString where mimeRender _ = P.id+-- | @BL.fromStrict . T.encodeUtf8@+instance MimeRender MimePlainText T.Text where mimeRender _ = BL.fromStrict . T.encodeUtf8+-- | @BCL.pack@+instance MimeRender MimePlainText String where mimeRender _ = BCL.pack++-- | @P.id@+instance MimeRender MimeOctetStream BL.ByteString where mimeRender _ = P.id+-- | @BL.fromStrict . T.encodeUtf8@+instance MimeRender MimeOctetStream T.Text where mimeRender _ = BL.fromStrict . T.encodeUtf8+-- | @BCL.pack@+instance MimeRender MimeOctetStream String where mimeRender _ = BCL.pack++instance MimeRender MimeMultipartFormData BL.ByteString where mimeRender _ = P.id++instance MimeRender MimeMultipartFormData Bool where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Char where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Double where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Float where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Int where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Integer where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData String where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData T.Text where mimeRender _ = mimeRenderDefaultMultipartFormData++-- | @P.Right . P.const NoContent@+instance MimeRender MimeNoContent NoContent where mimeRender _ = P.const BCL.empty+++-- * MimeUnrender Class++class MimeType mtype => MimeUnrender mtype o where+    mimeUnrender :: P.Proxy mtype -> BL.ByteString -> P.Either String o+    mimeUnrender' :: mtype -> BL.ByteString -> P.Either String o+    mimeUnrender' _ x = mimeUnrender (P.Proxy :: P.Proxy mtype) x++-- Default MimeUnrender Instances++-- | @A.eitherDecode@+instance A.FromJSON a => MimeUnrender MimeJSON a where mimeUnrender _ = A.eitherDecode+-- | @P.left T.unpack . WH.urlDecodeAsForm@+instance WH.FromForm a => MimeUnrender MimeFormUrlEncoded a where mimeUnrender _ = P.left T.unpack . WH.urlDecodeAsForm+-- | @P.Right . P.id@++instance MimeUnrender MimePlainText BL.ByteString where mimeUnrender _ = P.Right . P.id+-- | @P.left P.show . TL.decodeUtf8'@+instance MimeUnrender MimePlainText T.Text where mimeUnrender _ = P.left P.show . T.decodeUtf8' . BL.toStrict+-- | @P.Right . BCL.unpack@+instance MimeUnrender MimePlainText String where mimeUnrender _ = P.Right . BCL.unpack++-- | @P.Right . P.id@+instance MimeUnrender MimeOctetStream BL.ByteString where mimeUnrender _ = P.Right . P.id+-- | @P.left P.show . T.decodeUtf8' . BL.toStrict@+instance MimeUnrender MimeOctetStream T.Text where mimeUnrender _ = P.left P.show . T.decodeUtf8' . BL.toStrict+-- | @P.Right . BCL.unpack@+instance MimeUnrender MimeOctetStream String where mimeUnrender _ = P.Right . BCL.unpack++-- | @P.Right . P.const NoContent@+instance MimeUnrender MimeNoContent NoContent where mimeUnrender _ = P.Right . P.const NoContent++
+ lib/Httpstan/Model.hs view
@@ -0,0 +1,627 @@+{-+   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 { unAdjustTransform :: Bool } deriving (P.Eq, P.Show, A.ToJSON)++-- ** ConstrainedParameters+newtype ConstrainedParameters = ConstrainedParameters { unConstrainedParameters :: A.Value } deriving (P.Eq, P.Show, A.ToJSON)++-- ** FitId+newtype FitId = FitId { unFitId :: Text } deriving (P.Eq, P.Show)++-- ** IncludeGqs+newtype IncludeGqs = IncludeGqs { unIncludeGqs :: Bool } deriving (P.Eq, P.Show, A.ToJSON)++-- ** ModelId+newtype ModelId = ModelId { unModelId :: Text } deriving (P.Eq, P.Show)++-- ** OperationId+newtype OperationId = OperationId { unOperationId :: Text } deriving (P.Eq, P.Show)++-- ** ParamData+newtype ParamData = ParamData { unParamData :: A.Value } deriving (P.Eq, P.Show, A.ToJSON)++-- * Models+++-- ** CreateFitRequest+-- | CreateFitRequest+data CreateFitRequest = CreateFitRequest+  { createFitRequestChain :: !(Maybe Int) -- ^ "chain"+  , createFitRequestData :: !(Maybe A.Value) -- ^ "data"+  , createFitRequestDelta :: !(Maybe Double) -- ^ "delta"+  , createFitRequestFunction :: !(E'Function) -- ^ /Required/ "function"+  , createFitRequestGamma :: !(Maybe Double) -- ^ "gamma"+  , createFitRequestInit :: !(Maybe A.Value) -- ^ "init"+  , createFitRequestInitBuffer :: !(Maybe Int) -- ^ "init_buffer"+  , createFitRequestInitRadius :: !(Maybe Double) -- ^ "init_radius"+  , createFitRequestKappa :: !(Maybe Double) -- ^ "kappa"+  , createFitRequestMaxDepth :: !(Maybe Int) -- ^ "max_depth"+  , createFitRequestNumSamples :: !(Maybe Int) -- ^ "num_samples"+  , createFitRequestNumThin :: !(Maybe Int) -- ^ "num_thin"+  , createFitRequestNumWarmup :: !(Maybe Int) -- ^ "num_warmup"+  , createFitRequestRandomSeed :: !(Maybe Int) -- ^ "random_seed"+  , createFitRequestRefresh :: !(Maybe Int) -- ^ "refresh"+  , createFitRequestSaveWarmup :: !(Maybe Bool) -- ^ "save_warmup"+  , createFitRequestStepsize :: !(Maybe Double) -- ^ "stepsize"+  , createFitRequestStepsizeJitter :: !(Maybe Double) -- ^ "stepsize_jitter"+  , createFitRequestT0 :: !(Maybe Double) -- ^ "t0"+  , createFitRequestTermBuffer :: !(Maybe Int) -- ^ "term_buffer"+  , createFitRequestWindow :: !(Maybe Int) -- ^ "window"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON CreateFitRequest+instance A.FromJSON CreateFitRequest where+  parseJSON = A.withObject "CreateFitRequest" $ \o ->+    CreateFitRequest+      <$> (o .:? "chain")+      <*> (o .:? "data")+      <*> (o .:? "delta")+      <*> (o .:  "function")+      <*> (o .:? "gamma")+      <*> (o .:? "init")+      <*> (o .:? "init_buffer")+      <*> (o .:? "init_radius")+      <*> (o .:? "kappa")+      <*> (o .:? "max_depth")+      <*> (o .:? "num_samples")+      <*> (o .:? "num_thin")+      <*> (o .:? "num_warmup")+      <*> (o .:? "random_seed")+      <*> (o .:? "refresh")+      <*> (o .:? "save_warmup")+      <*> (o .:? "stepsize")+      <*> (o .:? "stepsize_jitter")+      <*> (o .:? "t0")+      <*> (o .:? "term_buffer")+      <*> (o .:? "window")++-- | ToJSON CreateFitRequest+instance A.ToJSON CreateFitRequest where+  toJSON CreateFitRequest {..} =+   _omitNulls+      [ "chain" .= createFitRequestChain+      , "data" .= createFitRequestData+      , "delta" .= createFitRequestDelta+      , "function" .= createFitRequestFunction+      , "gamma" .= createFitRequestGamma+      , "init" .= createFitRequestInit+      , "init_buffer" .= createFitRequestInitBuffer+      , "init_radius" .= createFitRequestInitRadius+      , "kappa" .= createFitRequestKappa+      , "max_depth" .= createFitRequestMaxDepth+      , "num_samples" .= createFitRequestNumSamples+      , "num_thin" .= createFitRequestNumThin+      , "num_warmup" .= createFitRequestNumWarmup+      , "random_seed" .= createFitRequestRandomSeed+      , "refresh" .= createFitRequestRefresh+      , "save_warmup" .= createFitRequestSaveWarmup+      , "stepsize" .= createFitRequestStepsize+      , "stepsize_jitter" .= createFitRequestStepsizeJitter+      , "t0" .= createFitRequestT0+      , "term_buffer" .= createFitRequestTermBuffer+      , "window" .= createFitRequestWindow+      ]+++-- | Construct a value of type 'CreateFitRequest' (by applying it's required fields, if any)+mkCreateFitRequest+  :: E'Function -- ^ 'createFitRequestFunction' +  -> CreateFitRequest+mkCreateFitRequest createFitRequestFunction =+  CreateFitRequest+  { createFitRequestChain = Nothing+  , createFitRequestData = Nothing+  , createFitRequestDelta = Nothing+  , createFitRequestFunction+  , createFitRequestGamma = Nothing+  , createFitRequestInit = Nothing+  , createFitRequestInitBuffer = Nothing+  , createFitRequestInitRadius = Nothing+  , createFitRequestKappa = Nothing+  , createFitRequestMaxDepth = Nothing+  , createFitRequestNumSamples = Nothing+  , createFitRequestNumThin = Nothing+  , createFitRequestNumWarmup = Nothing+  , createFitRequestRandomSeed = Nothing+  , createFitRequestRefresh = Nothing+  , createFitRequestSaveWarmup = Nothing+  , createFitRequestStepsize = Nothing+  , createFitRequestStepsizeJitter = Nothing+  , createFitRequestT0 = Nothing+  , createFitRequestTermBuffer = Nothing+  , createFitRequestWindow = Nothing+  }++-- ** CreateModelRequest+-- | CreateModelRequest+data CreateModelRequest = CreateModelRequest+  { createModelRequestProgramCode :: !(Text) -- ^ /Required/ "program_code"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON CreateModelRequest+instance A.FromJSON CreateModelRequest where+  parseJSON = A.withObject "CreateModelRequest" $ \o ->+    CreateModelRequest+      <$> (o .:  "program_code")++-- | ToJSON CreateModelRequest+instance A.ToJSON CreateModelRequest where+  toJSON CreateModelRequest {..} =+   _omitNulls+      [ "program_code" .= createModelRequestProgramCode+      ]+++-- | Construct a value of type 'CreateModelRequest' (by applying it's required fields, if any)+mkCreateModelRequest+  :: Text -- ^ 'createModelRequestProgramCode' +  -> CreateModelRequest+mkCreateModelRequest createModelRequestProgramCode =+  CreateModelRequest+  { createModelRequestProgramCode+  }++-- ** Fit+-- | Fit+data Fit = Fit+  { fitName :: !(Text) -- ^ /Required/ "name"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON Fit+instance A.FromJSON Fit where+  parseJSON = A.withObject "Fit" $ \o ->+    Fit+      <$> (o .:  "name")++-- | ToJSON Fit+instance A.ToJSON Fit where+  toJSON Fit {..} =+   _omitNulls+      [ "name" .= fitName+      ]+++-- | Construct a value of type 'Fit' (by applying it's required fields, if any)+mkFit+  :: Text -- ^ 'fitName' +  -> Fit+mkFit fitName =+  Fit+  { fitName+  }++-- ** Model+-- | Model+data Model = Model+  { modelCompilerOutput :: !(Text) -- ^ /Required/ "compiler_output"+  , modelName :: !(Text) -- ^ /Required/ "name"+  , modelStancWarnings :: !(Text) -- ^ /Required/ "stanc_warnings"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON Model+instance A.FromJSON Model where+  parseJSON = A.withObject "Model" $ \o ->+    Model+      <$> (o .:  "compiler_output")+      <*> (o .:  "name")+      <*> (o .:  "stanc_warnings")++-- | ToJSON Model+instance A.ToJSON Model where+  toJSON Model {..} =+   _omitNulls+      [ "compiler_output" .= modelCompilerOutput+      , "name" .= modelName+      , "stanc_warnings" .= modelStancWarnings+      ]+++-- | Construct a value of type 'Model' (by applying it's required fields, if any)+mkModel+  :: Text -- ^ 'modelCompilerOutput' +  -> Text -- ^ 'modelName' +  -> Text -- ^ 'modelStancWarnings' +  -> Model+mkModel modelCompilerOutput modelName modelStancWarnings =+  Model+  { modelCompilerOutput+  , modelName+  , modelStancWarnings+  }++-- ** Operation+-- | Operation+data Operation = Operation+  { operationDone :: !(Bool) -- ^ /Required/ "done"+  , operationMetadata :: !(Maybe A.Value) -- ^ "metadata"+  , operationName :: !(Text) -- ^ /Required/ "name"+  , operationResult :: !(Maybe A.Value) -- ^ "result"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON Operation+instance A.FromJSON Operation where+  parseJSON = A.withObject "Operation" $ \o ->+    Operation+      <$> (o .:  "done")+      <*> (o .:? "metadata")+      <*> (o .:  "name")+      <*> (o .:? "result")++-- | ToJSON Operation+instance A.ToJSON Operation where+  toJSON Operation {..} =+   _omitNulls+      [ "done" .= operationDone+      , "metadata" .= operationMetadata+      , "name" .= operationName+      , "result" .= operationResult+      ]+++-- | Construct a value of type 'Operation' (by applying it's required fields, if any)+mkOperation+  :: Bool -- ^ 'operationDone' +  -> Text -- ^ 'operationName' +  -> Operation+mkOperation operationDone operationName =+  Operation+  { operationDone+  , operationMetadata = Nothing+  , operationName+  , operationResult = Nothing+  }++-- ** Parameter+-- | Parameter+data Parameter = Parameter+  { parameterConstrainedNames :: !([Text]) -- ^ /Required/ "constrained_names"+  , parameterDims :: !([Int]) -- ^ /Required/ "dims"+  , parameterName :: !(Text) -- ^ /Required/ "name"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON Parameter+instance A.FromJSON Parameter where+  parseJSON = A.withObject "Parameter" $ \o ->+    Parameter+      <$> (o .:  "constrained_names")+      <*> (o .:  "dims")+      <*> (o .:  "name")++-- | ToJSON Parameter+instance A.ToJSON Parameter where+  toJSON Parameter {..} =+   _omitNulls+      [ "constrained_names" .= parameterConstrainedNames+      , "dims" .= parameterDims+      , "name" .= parameterName+      ]+++-- | Construct a value of type 'Parameter' (by applying it's required fields, if any)+mkParameter+  :: [Text] -- ^ 'parameterConstrainedNames' +  -> [Int] -- ^ 'parameterDims' +  -> Text -- ^ 'parameterName' +  -> Parameter+mkParameter parameterConstrainedNames parameterDims parameterName =+  Parameter+  { parameterConstrainedNames+  , parameterDims+  , parameterName+  }++-- ** Status+-- | Status+data Status = Status+  { statusCode :: !(Int) -- ^ /Required/ "code"+  , statusDetails :: !(Maybe [A.Value]) -- ^ "details"+  , statusMessage :: !(Text) -- ^ /Required/ "message"+  , statusStatus :: !(Text) -- ^ /Required/ "status"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON Status+instance A.FromJSON Status where+  parseJSON = A.withObject "Status" $ \o ->+    Status+      <$> (o .:  "code")+      <*> (o .:? "details")+      <*> (o .:  "message")+      <*> (o .:  "status")++-- | ToJSON Status+instance A.ToJSON Status where+  toJSON Status {..} =+   _omitNulls+      [ "code" .= statusCode+      , "details" .= statusDetails+      , "message" .= statusMessage+      , "status" .= statusStatus+      ]+++-- | Construct a value of type 'Status' (by applying it's required fields, if any)+mkStatus+  :: Int -- ^ 'statusCode' +  -> Text -- ^ 'statusMessage' +  -> Text -- ^ 'statusStatus' +  -> Status+mkStatus statusCode statusMessage statusStatus =+  Status+  { statusCode+  , statusDetails = Nothing+  , statusMessage+  , statusStatus+  }++-- ** V1ModelsGet200Response+-- | V1ModelsGet200Response+data V1ModelsGet200Response = V1ModelsGet200Response+  { v1ModelsGet200ResponseModels :: !(Maybe [Model]) -- ^ "models"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON V1ModelsGet200Response+instance A.FromJSON V1ModelsGet200Response where+  parseJSON = A.withObject "V1ModelsGet200Response" $ \o ->+    V1ModelsGet200Response+      <$> (o .:? "models")++-- | ToJSON V1ModelsGet200Response+instance A.ToJSON V1ModelsGet200Response where+  toJSON V1ModelsGet200Response {..} =+   _omitNulls+      [ "models" .= v1ModelsGet200ResponseModels+      ]+++-- | Construct a value of type 'V1ModelsGet200Response' (by applying it's required fields, if any)+mkV1ModelsGet200Response+  :: V1ModelsGet200Response+mkV1ModelsGet200Response =+  V1ModelsGet200Response+  { v1ModelsGet200ResponseModels = Nothing+  }++-- ** V1ModelsModelIdLogProbGradPost200Response+-- | V1ModelsModelIdLogProbGradPost200Response+data V1ModelsModelIdLogProbGradPost200Response = V1ModelsModelIdLogProbGradPost200Response+  { v1ModelsModelIdLogProbGradPost200ResponseGradLogProb :: !(Maybe [Double]) -- ^ "grad_log_prob"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON V1ModelsModelIdLogProbGradPost200Response+instance A.FromJSON V1ModelsModelIdLogProbGradPost200Response where+  parseJSON = A.withObject "V1ModelsModelIdLogProbGradPost200Response" $ \o ->+    V1ModelsModelIdLogProbGradPost200Response+      <$> (o .:? "grad_log_prob")++-- | ToJSON V1ModelsModelIdLogProbGradPost200Response+instance A.ToJSON V1ModelsModelIdLogProbGradPost200Response where+  toJSON V1ModelsModelIdLogProbGradPost200Response {..} =+   _omitNulls+      [ "grad_log_prob" .= v1ModelsModelIdLogProbGradPost200ResponseGradLogProb+      ]+++-- | Construct a value of type 'V1ModelsModelIdLogProbGradPost200Response' (by applying it's required fields, if any)+mkV1ModelsModelIdLogProbGradPost200Response+  :: V1ModelsModelIdLogProbGradPost200Response+mkV1ModelsModelIdLogProbGradPost200Response =+  V1ModelsModelIdLogProbGradPost200Response+  { v1ModelsModelIdLogProbGradPost200ResponseGradLogProb = Nothing+  }++-- ** V1ModelsModelIdLogProbPost200Response+-- | V1ModelsModelIdLogProbPost200Response+data V1ModelsModelIdLogProbPost200Response = V1ModelsModelIdLogProbPost200Response+  { v1ModelsModelIdLogProbPost200ResponseLogProb :: !(Maybe Double) -- ^ "log_prob"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON V1ModelsModelIdLogProbPost200Response+instance A.FromJSON V1ModelsModelIdLogProbPost200Response where+  parseJSON = A.withObject "V1ModelsModelIdLogProbPost200Response" $ \o ->+    V1ModelsModelIdLogProbPost200Response+      <$> (o .:? "log_prob")++-- | ToJSON V1ModelsModelIdLogProbPost200Response+instance A.ToJSON V1ModelsModelIdLogProbPost200Response where+  toJSON V1ModelsModelIdLogProbPost200Response {..} =+   _omitNulls+      [ "log_prob" .= v1ModelsModelIdLogProbPost200ResponseLogProb+      ]+++-- | Construct a value of type 'V1ModelsModelIdLogProbPost200Response' (by applying it's required fields, if any)+mkV1ModelsModelIdLogProbPost200Response+  :: V1ModelsModelIdLogProbPost200Response+mkV1ModelsModelIdLogProbPost200Response =+  V1ModelsModelIdLogProbPost200Response+  { v1ModelsModelIdLogProbPost200ResponseLogProb = Nothing+  }++-- ** V1ModelsModelIdParamsPost200Response+-- | V1ModelsModelIdParamsPost200Response+data V1ModelsModelIdParamsPost200Response = V1ModelsModelIdParamsPost200Response+  { v1ModelsModelIdParamsPost200ResponseId :: !(Maybe Text) -- ^ "id"+  , v1ModelsModelIdParamsPost200ResponseParams :: !(Maybe [Parameter]) -- ^ "params"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON V1ModelsModelIdParamsPost200Response+instance A.FromJSON V1ModelsModelIdParamsPost200Response where+  parseJSON = A.withObject "V1ModelsModelIdParamsPost200Response" $ \o ->+    V1ModelsModelIdParamsPost200Response+      <$> (o .:? "id")+      <*> (o .:? "params")++-- | ToJSON V1ModelsModelIdParamsPost200Response+instance A.ToJSON V1ModelsModelIdParamsPost200Response where+  toJSON V1ModelsModelIdParamsPost200Response {..} =+   _omitNulls+      [ "id" .= v1ModelsModelIdParamsPost200ResponseId+      , "params" .= v1ModelsModelIdParamsPost200ResponseParams+      ]+++-- | Construct a value of type 'V1ModelsModelIdParamsPost200Response' (by applying it's required fields, if any)+mkV1ModelsModelIdParamsPost200Response+  :: V1ModelsModelIdParamsPost200Response+mkV1ModelsModelIdParamsPost200Response =+  V1ModelsModelIdParamsPost200Response+  { v1ModelsModelIdParamsPost200ResponseId = Nothing+  , v1ModelsModelIdParamsPost200ResponseParams = Nothing+  }++-- ** V1ModelsModelIdTransformInitsPost200Response+-- | V1ModelsModelIdTransformInitsPost200Response+data V1ModelsModelIdTransformInitsPost200Response = V1ModelsModelIdTransformInitsPost200Response+  { v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained :: !(Maybe [Double]) -- ^ "params_r_unconstrained"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON V1ModelsModelIdTransformInitsPost200Response+instance A.FromJSON V1ModelsModelIdTransformInitsPost200Response where+  parseJSON = A.withObject "V1ModelsModelIdTransformInitsPost200Response" $ \o ->+    V1ModelsModelIdTransformInitsPost200Response+      <$> (o .:? "params_r_unconstrained")++-- | ToJSON V1ModelsModelIdTransformInitsPost200Response+instance A.ToJSON V1ModelsModelIdTransformInitsPost200Response where+  toJSON V1ModelsModelIdTransformInitsPost200Response {..} =+   _omitNulls+      [ "params_r_unconstrained" .= v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained+      ]+++-- | Construct a value of type 'V1ModelsModelIdTransformInitsPost200Response' (by applying it's required fields, if any)+mkV1ModelsModelIdTransformInitsPost200Response+  :: V1ModelsModelIdTransformInitsPost200Response+mkV1ModelsModelIdTransformInitsPost200Response =+  V1ModelsModelIdTransformInitsPost200Response+  { v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained = Nothing+  }++-- ** V1ModelsModelIdWriteArrayPost200Response+-- | V1ModelsModelIdWriteArrayPost200Response+data V1ModelsModelIdWriteArrayPost200Response = V1ModelsModelIdWriteArrayPost200Response+  { v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained :: !(Maybe [Double]) -- ^ "params_r_constrained"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON V1ModelsModelIdWriteArrayPost200Response+instance A.FromJSON V1ModelsModelIdWriteArrayPost200Response where+  parseJSON = A.withObject "V1ModelsModelIdWriteArrayPost200Response" $ \o ->+    V1ModelsModelIdWriteArrayPost200Response+      <$> (o .:? "params_r_constrained")++-- | ToJSON V1ModelsModelIdWriteArrayPost200Response+instance A.ToJSON V1ModelsModelIdWriteArrayPost200Response where+  toJSON V1ModelsModelIdWriteArrayPost200Response {..} =+   _omitNulls+      [ "params_r_constrained" .= v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained+      ]+++-- | Construct a value of type 'V1ModelsModelIdWriteArrayPost200Response' (by applying it's required fields, if any)+mkV1ModelsModelIdWriteArrayPost200Response+  :: V1ModelsModelIdWriteArrayPost200Response+mkV1ModelsModelIdWriteArrayPost200Response =+  V1ModelsModelIdWriteArrayPost200Response+  { v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained = 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 (P.Show, P.Eq, P.Typeable, P.Ord, P.Bounded, P.Enum)++instance A.ToJSON E'Function where toJSON = A.toJSON . fromE'Function+instance A.FromJSON E'Function where parseJSON o = P.either P.fail (pure . P.id) . toE'Function =<< A.parseJSON o+instance WH.ToHttpApiData E'Function where toQueryParam = WH.toQueryParam . fromE'Function+instance WH.FromHttpApiData E'Function where parseQueryParam o = WH.parseQueryParam o >>= P.left T.pack . toE'Function+instance MimeRender MimeMultipartFormData E'Function where mimeRender _ = mimeRenderDefaultMultipartFormData++-- | unwrap 'E'Function' enum+fromE'Function :: E'Function -> Text+fromE'Function = \case+  E'Function'Hmc_nuts_diag_e_adapt -> "stan::services::sample::hmc_nuts_diag_e_adapt"+  E'Function'Fixed_param -> "stan::services::sample::fixed_param"++-- | parse 'E'Function' enum+toE'Function :: Text -> P.Either String E'Function+toE'Function = \case+  "stan::services::sample::hmc_nuts_diag_e_adapt" -> P.Right E'Function'Hmc_nuts_diag_e_adapt+  "stan::services::sample::fixed_param" -> P.Right E'Function'Fixed_param+  s -> P.Left $ "toE'Function: enum parse failure: " P.++ P.show s+++
+ lib/Httpstan/ModelLens.hs view
@@ -0,0 +1,309 @@+{-+   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.Lens+-}++{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}++module Httpstan.ModelLens where++import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy as BL+import qualified Data.Data as P (Data, Typeable)+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Time as TI++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++import Httpstan.Model+import Httpstan.Core+++-- * CreateFitRequest++-- | 'createFitRequestChain' Lens+createFitRequestChainL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestChainL f CreateFitRequest{..} = (\createFitRequestChain -> CreateFitRequest { createFitRequestChain, ..} ) <$> f createFitRequestChain+{-# INLINE createFitRequestChainL #-}++-- | 'createFitRequestData' Lens+createFitRequestDataL :: Lens_' CreateFitRequest (Maybe A.Value)+createFitRequestDataL f CreateFitRequest{..} = (\createFitRequestData -> CreateFitRequest { createFitRequestData, ..} ) <$> f createFitRequestData+{-# INLINE createFitRequestDataL #-}++-- | 'createFitRequestDelta' Lens+createFitRequestDeltaL :: Lens_' CreateFitRequest (Maybe Double)+createFitRequestDeltaL f CreateFitRequest{..} = (\createFitRequestDelta -> CreateFitRequest { createFitRequestDelta, ..} ) <$> f createFitRequestDelta+{-# INLINE createFitRequestDeltaL #-}++-- | 'createFitRequestFunction' Lens+createFitRequestFunctionL :: Lens_' CreateFitRequest (E'Function)+createFitRequestFunctionL f CreateFitRequest{..} = (\createFitRequestFunction -> CreateFitRequest { createFitRequestFunction, ..} ) <$> f createFitRequestFunction+{-# INLINE createFitRequestFunctionL #-}++-- | 'createFitRequestGamma' Lens+createFitRequestGammaL :: Lens_' CreateFitRequest (Maybe Double)+createFitRequestGammaL f CreateFitRequest{..} = (\createFitRequestGamma -> CreateFitRequest { createFitRequestGamma, ..} ) <$> f createFitRequestGamma+{-# INLINE createFitRequestGammaL #-}++-- | 'createFitRequestInit' Lens+createFitRequestInitL :: Lens_' CreateFitRequest (Maybe A.Value)+createFitRequestInitL f CreateFitRequest{..} = (\createFitRequestInit -> CreateFitRequest { createFitRequestInit, ..} ) <$> f createFitRequestInit+{-# INLINE createFitRequestInitL #-}++-- | 'createFitRequestInitBuffer' Lens+createFitRequestInitBufferL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestInitBufferL f CreateFitRequest{..} = (\createFitRequestInitBuffer -> CreateFitRequest { createFitRequestInitBuffer, ..} ) <$> f createFitRequestInitBuffer+{-# INLINE createFitRequestInitBufferL #-}++-- | 'createFitRequestInitRadius' Lens+createFitRequestInitRadiusL :: Lens_' CreateFitRequest (Maybe Double)+createFitRequestInitRadiusL f CreateFitRequest{..} = (\createFitRequestInitRadius -> CreateFitRequest { createFitRequestInitRadius, ..} ) <$> f createFitRequestInitRadius+{-# INLINE createFitRequestInitRadiusL #-}++-- | 'createFitRequestKappa' Lens+createFitRequestKappaL :: Lens_' CreateFitRequest (Maybe Double)+createFitRequestKappaL f CreateFitRequest{..} = (\createFitRequestKappa -> CreateFitRequest { createFitRequestKappa, ..} ) <$> f createFitRequestKappa+{-# INLINE createFitRequestKappaL #-}++-- | 'createFitRequestMaxDepth' Lens+createFitRequestMaxDepthL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestMaxDepthL f CreateFitRequest{..} = (\createFitRequestMaxDepth -> CreateFitRequest { createFitRequestMaxDepth, ..} ) <$> f createFitRequestMaxDepth+{-# INLINE createFitRequestMaxDepthL #-}++-- | 'createFitRequestNumSamples' Lens+createFitRequestNumSamplesL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestNumSamplesL f CreateFitRequest{..} = (\createFitRequestNumSamples -> CreateFitRequest { createFitRequestNumSamples, ..} ) <$> f createFitRequestNumSamples+{-# INLINE createFitRequestNumSamplesL #-}++-- | 'createFitRequestNumThin' Lens+createFitRequestNumThinL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestNumThinL f CreateFitRequest{..} = (\createFitRequestNumThin -> CreateFitRequest { createFitRequestNumThin, ..} ) <$> f createFitRequestNumThin+{-# INLINE createFitRequestNumThinL #-}++-- | 'createFitRequestNumWarmup' Lens+createFitRequestNumWarmupL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestNumWarmupL f CreateFitRequest{..} = (\createFitRequestNumWarmup -> CreateFitRequest { createFitRequestNumWarmup, ..} ) <$> f createFitRequestNumWarmup+{-# INLINE createFitRequestNumWarmupL #-}++-- | 'createFitRequestRandomSeed' Lens+createFitRequestRandomSeedL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestRandomSeedL f CreateFitRequest{..} = (\createFitRequestRandomSeed -> CreateFitRequest { createFitRequestRandomSeed, ..} ) <$> f createFitRequestRandomSeed+{-# INLINE createFitRequestRandomSeedL #-}++-- | 'createFitRequestRefresh' Lens+createFitRequestRefreshL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestRefreshL f CreateFitRequest{..} = (\createFitRequestRefresh -> CreateFitRequest { createFitRequestRefresh, ..} ) <$> f createFitRequestRefresh+{-# INLINE createFitRequestRefreshL #-}++-- | 'createFitRequestSaveWarmup' Lens+createFitRequestSaveWarmupL :: Lens_' CreateFitRequest (Maybe Bool)+createFitRequestSaveWarmupL f CreateFitRequest{..} = (\createFitRequestSaveWarmup -> CreateFitRequest { createFitRequestSaveWarmup, ..} ) <$> f createFitRequestSaveWarmup+{-# INLINE createFitRequestSaveWarmupL #-}++-- | 'createFitRequestStepsize' Lens+createFitRequestStepsizeL :: Lens_' CreateFitRequest (Maybe Double)+createFitRequestStepsizeL f CreateFitRequest{..} = (\createFitRequestStepsize -> CreateFitRequest { createFitRequestStepsize, ..} ) <$> f createFitRequestStepsize+{-# INLINE createFitRequestStepsizeL #-}++-- | 'createFitRequestStepsizeJitter' Lens+createFitRequestStepsizeJitterL :: Lens_' CreateFitRequest (Maybe Double)+createFitRequestStepsizeJitterL f CreateFitRequest{..} = (\createFitRequestStepsizeJitter -> CreateFitRequest { createFitRequestStepsizeJitter, ..} ) <$> f createFitRequestStepsizeJitter+{-# INLINE createFitRequestStepsizeJitterL #-}++-- | 'createFitRequestT0' Lens+createFitRequestT0L :: Lens_' CreateFitRequest (Maybe Double)+createFitRequestT0L f CreateFitRequest{..} = (\createFitRequestT0 -> CreateFitRequest { createFitRequestT0, ..} ) <$> f createFitRequestT0+{-# INLINE createFitRequestT0L #-}++-- | 'createFitRequestTermBuffer' Lens+createFitRequestTermBufferL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestTermBufferL f CreateFitRequest{..} = (\createFitRequestTermBuffer -> CreateFitRequest { createFitRequestTermBuffer, ..} ) <$> f createFitRequestTermBuffer+{-# INLINE createFitRequestTermBufferL #-}++-- | 'createFitRequestWindow' Lens+createFitRequestWindowL :: Lens_' CreateFitRequest (Maybe Int)+createFitRequestWindowL f CreateFitRequest{..} = (\createFitRequestWindow -> CreateFitRequest { createFitRequestWindow, ..} ) <$> f createFitRequestWindow+{-# INLINE createFitRequestWindowL #-}++++-- * CreateModelRequest++-- | 'createModelRequestProgramCode' Lens+createModelRequestProgramCodeL :: Lens_' CreateModelRequest (Text)+createModelRequestProgramCodeL f CreateModelRequest{..} = (\createModelRequestProgramCode -> CreateModelRequest { createModelRequestProgramCode, ..} ) <$> f createModelRequestProgramCode+{-# INLINE createModelRequestProgramCodeL #-}++++-- * Fit++-- | 'fitName' Lens+fitNameL :: Lens_' Fit (Text)+fitNameL f Fit{..} = (\fitName -> Fit { fitName, ..} ) <$> f fitName+{-# INLINE fitNameL #-}++++-- * Model++-- | 'modelCompilerOutput' Lens+modelCompilerOutputL :: Lens_' Model (Text)+modelCompilerOutputL f Model{..} = (\modelCompilerOutput -> Model { modelCompilerOutput, ..} ) <$> f modelCompilerOutput+{-# INLINE modelCompilerOutputL #-}++-- | 'modelName' Lens+modelNameL :: Lens_' Model (Text)+modelNameL f Model{..} = (\modelName -> Model { modelName, ..} ) <$> f modelName+{-# INLINE modelNameL #-}++-- | 'modelStancWarnings' Lens+modelStancWarningsL :: Lens_' Model (Text)+modelStancWarningsL f Model{..} = (\modelStancWarnings -> Model { modelStancWarnings, ..} ) <$> f modelStancWarnings+{-# INLINE modelStancWarningsL #-}++++-- * Operation++-- | 'operationDone' Lens+operationDoneL :: Lens_' Operation (Bool)+operationDoneL f Operation{..} = (\operationDone -> Operation { operationDone, ..} ) <$> f operationDone+{-# INLINE operationDoneL #-}++-- | 'operationMetadata' Lens+operationMetadataL :: Lens_' Operation (Maybe A.Value)+operationMetadataL f Operation{..} = (\operationMetadata -> Operation { operationMetadata, ..} ) <$> f operationMetadata+{-# INLINE operationMetadataL #-}++-- | 'operationName' Lens+operationNameL :: Lens_' Operation (Text)+operationNameL f Operation{..} = (\operationName -> Operation { operationName, ..} ) <$> f operationName+{-# INLINE operationNameL #-}++-- | 'operationResult' Lens+operationResultL :: Lens_' Operation (Maybe A.Value)+operationResultL f Operation{..} = (\operationResult -> Operation { operationResult, ..} ) <$> f operationResult+{-# INLINE operationResultL #-}++++-- * Parameter++-- | 'parameterConstrainedNames' Lens+parameterConstrainedNamesL :: Lens_' Parameter ([Text])+parameterConstrainedNamesL f Parameter{..} = (\parameterConstrainedNames -> Parameter { parameterConstrainedNames, ..} ) <$> f parameterConstrainedNames+{-# INLINE parameterConstrainedNamesL #-}++-- | 'parameterDims' Lens+parameterDimsL :: Lens_' Parameter ([Int])+parameterDimsL f Parameter{..} = (\parameterDims -> Parameter { parameterDims, ..} ) <$> f parameterDims+{-# INLINE parameterDimsL #-}++-- | 'parameterName' Lens+parameterNameL :: Lens_' Parameter (Text)+parameterNameL f Parameter{..} = (\parameterName -> Parameter { parameterName, ..} ) <$> f parameterName+{-# INLINE parameterNameL #-}++++-- * Status++-- | 'statusCode' Lens+statusCodeL :: Lens_' Status (Int)+statusCodeL f Status{..} = (\statusCode -> Status { statusCode, ..} ) <$> f statusCode+{-# INLINE statusCodeL #-}++-- | 'statusDetails' Lens+statusDetailsL :: Lens_' Status (Maybe [A.Value])+statusDetailsL f Status{..} = (\statusDetails -> Status { statusDetails, ..} ) <$> f statusDetails+{-# INLINE statusDetailsL #-}++-- | 'statusMessage' Lens+statusMessageL :: Lens_' Status (Text)+statusMessageL f Status{..} = (\statusMessage -> Status { statusMessage, ..} ) <$> f statusMessage+{-# INLINE statusMessageL #-}++-- | 'statusStatus' Lens+statusStatusL :: Lens_' Status (Text)+statusStatusL f Status{..} = (\statusStatus -> Status { statusStatus, ..} ) <$> f statusStatus+{-# INLINE statusStatusL #-}++++-- * V1ModelsGet200Response++-- | 'v1ModelsGet200ResponseModels' Lens+v1ModelsGet200ResponseModelsL :: Lens_' V1ModelsGet200Response (Maybe [Model])+v1ModelsGet200ResponseModelsL f V1ModelsGet200Response{..} = (\v1ModelsGet200ResponseModels -> V1ModelsGet200Response { v1ModelsGet200ResponseModels, ..} ) <$> f v1ModelsGet200ResponseModels+{-# INLINE v1ModelsGet200ResponseModelsL #-}++++-- * V1ModelsModelIdLogProbGradPost200Response++-- | 'v1ModelsModelIdLogProbGradPost200ResponseGradLogProb' Lens+v1ModelsModelIdLogProbGradPost200ResponseGradLogProbL :: Lens_' V1ModelsModelIdLogProbGradPost200Response (Maybe [Double])+v1ModelsModelIdLogProbGradPost200ResponseGradLogProbL f V1ModelsModelIdLogProbGradPost200Response{..} = (\v1ModelsModelIdLogProbGradPost200ResponseGradLogProb -> V1ModelsModelIdLogProbGradPost200Response { v1ModelsModelIdLogProbGradPost200ResponseGradLogProb, ..} ) <$> f v1ModelsModelIdLogProbGradPost200ResponseGradLogProb+{-# INLINE v1ModelsModelIdLogProbGradPost200ResponseGradLogProbL #-}++++-- * V1ModelsModelIdLogProbPost200Response++-- | 'v1ModelsModelIdLogProbPost200ResponseLogProb' Lens+v1ModelsModelIdLogProbPost200ResponseLogProbL :: Lens_' V1ModelsModelIdLogProbPost200Response (Maybe Double)+v1ModelsModelIdLogProbPost200ResponseLogProbL f V1ModelsModelIdLogProbPost200Response{..} = (\v1ModelsModelIdLogProbPost200ResponseLogProb -> V1ModelsModelIdLogProbPost200Response { v1ModelsModelIdLogProbPost200ResponseLogProb, ..} ) <$> f v1ModelsModelIdLogProbPost200ResponseLogProb+{-# INLINE v1ModelsModelIdLogProbPost200ResponseLogProbL #-}++++-- * V1ModelsModelIdParamsPost200Response++-- | 'v1ModelsModelIdParamsPost200ResponseId' Lens+v1ModelsModelIdParamsPost200ResponseIdL :: Lens_' V1ModelsModelIdParamsPost200Response (Maybe Text)+v1ModelsModelIdParamsPost200ResponseIdL f V1ModelsModelIdParamsPost200Response{..} = (\v1ModelsModelIdParamsPost200ResponseId -> V1ModelsModelIdParamsPost200Response { v1ModelsModelIdParamsPost200ResponseId, ..} ) <$> f v1ModelsModelIdParamsPost200ResponseId+{-# INLINE v1ModelsModelIdParamsPost200ResponseIdL #-}++-- | 'v1ModelsModelIdParamsPost200ResponseParams' Lens+v1ModelsModelIdParamsPost200ResponseParamsL :: Lens_' V1ModelsModelIdParamsPost200Response (Maybe [Parameter])+v1ModelsModelIdParamsPost200ResponseParamsL f V1ModelsModelIdParamsPost200Response{..} = (\v1ModelsModelIdParamsPost200ResponseParams -> V1ModelsModelIdParamsPost200Response { v1ModelsModelIdParamsPost200ResponseParams, ..} ) <$> f v1ModelsModelIdParamsPost200ResponseParams+{-# INLINE v1ModelsModelIdParamsPost200ResponseParamsL #-}++++-- * V1ModelsModelIdTransformInitsPost200Response++-- | 'v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained' Lens+v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrainedL :: Lens_' V1ModelsModelIdTransformInitsPost200Response (Maybe [Double])+v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrainedL f V1ModelsModelIdTransformInitsPost200Response{..} = (\v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained -> V1ModelsModelIdTransformInitsPost200Response { v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained, ..} ) <$> f v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained+{-# INLINE v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrainedL #-}++++-- * V1ModelsModelIdWriteArrayPost200Response++-- | 'v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained' Lens+v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrainedL :: Lens_' V1ModelsModelIdWriteArrayPost200Response (Maybe [Double])+v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrainedL f V1ModelsModelIdWriteArrayPost200Response{..} = (\v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained -> V1ModelsModelIdWriteArrayPost200Response { v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained, ..} ) <$> f v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained+{-# INLINE v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrainedL #-}++
+ openapi.yaml view
@@ -0,0 +1,656 @@+openapi: 3.0.1+info:+  title: httpstan+  version: 4.10.0+servers:+- url: /+paths:+  /v1/health:+    get:+      description: Check if service is running.+      responses:+        "200":+          content: {}+          description: OK+  /v1/models:+    get:+      description: List cached models.+      responses:+        "200":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/_v1_models_get_200_response'+          description: Identifier for compiled Stan model and compiler output.+    post:+      description: Compile a Stan model+      requestBody:+        content:+          application/json:+            schema:+              $ref: '#/components/schemas/CreateModelRequest'+        description: Stan program code to compile+        required: true+      responses:+        "201":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Model'+          description: Identifier for compiled Stan model and compiler output.+        "400":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Error associated with compile request.+      x-codegen-request-body-name: body+  /v1/models/{model_id}:+    delete:+      description: Delete a model which has been saved in the cache.+      parameters:+      - description: ID of Stan model+        in: path+        name: model_id+        required: true+        schema:+          type: string+      responses:+        "200":+          content: {}+          description: Model successfully deleted.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Model not found.+      summary: Delete a model and any associated fits.+  /v1/models/{model_id}/params:+    post:+      description: "Returns the output of Stan C++ model class methods: ``constrained_param_names``,\+        \ ``get_param_names`` and ``get_dims``."+      parameters:+      - description: ID of Stan model to use+        in: path+        name: model_id+        required: true+        schema:+          type: string+      requestBody:+        content:+          application/json:+            schema:+              $ref: '#/components/schemas/Data'+        description: Data for Stan Model. Needed to calculate param names and dimensions.+        required: true+      responses:+        "200":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/_v1_models__model_id__params_post_200_response'+          description: Parameters for Stan Model+        "400":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Error associated with request.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Model not found.+      summary: Get parameter names and dimensions.+      x-codegen-request-body-name: data+  /v1/models/{model_id}/log_prob:+    post:+      description: Returns the output of Stan C++ ``log_prob`` model class method.+      parameters:+      - description: ID of Stan model to use+        in: path+        name: model_id+        required: true+        schema:+          type: string+      requestBody:+        content:+          application/json:+            schema:+              type: boolean+        description: Boolean to control whether we apply a Jacobian adjust transform.+        required: false+      responses:+        "200":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/_v1_models__model_id__log_prob_post_200_response'+          description: Log probability of the unconstrained parameters.+        "400":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Error associated with request.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Model not found.+      summary: Return the log probability of the unconstrained parameters.+      x-codegen-request-body-name: adjust_transform+  /v1/models/{model_id}/log_prob_grad:+    post:+      description: Returns the output of Stan C++ `stan::model::log_prob_grad`.+      parameters:+      - description: ID of Stan model to use+        in: path+        name: model_id+        required: true+        schema:+          type: string+      requestBody:+        content:+          application/json:+            schema:+              type: boolean+        description: Boolean to control whether we apply a Jacobian adjust transform.+        required: false+      responses:+        "200":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/_v1_models__model_id__log_prob_grad_post_200_response'+          description: Gradient of the log posterior evaluated at the unconstrained+            parameters.+        "400":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Error associated with request.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Model not found.+      summary: Return the gradient of the log posterior evaluated at the unconstrained+        parameters.+      x-codegen-request-body-name: adjust_transform+  /v1/models/{model_id}/write_array:+    post:+      description: Returns the output of Stan C++ ``write_array`` model class method.+      parameters:+      - description: ID of Stan model to use+        in: path+        name: model_id+        required: true+        schema:+          type: string+      requestBody:+        content:+          application/json:+            schema:+              type: boolean+        description: Boolean to control whether we include generated quantities.+        required: true+      responses:+        "200":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/_v1_models__model_id__write_array_post_200_response'+          description: "Sequence of constrained parameters, optionally including transformed\+            \ parameters and generated quantities."+        "400":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Error associated with request.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Model not found.+      summary: Return a sequence of constrained parameters.+      x-codegen-request-body-name: include_gqs+  /v1/models/{model_id}/transform_inits:+    post:+      description: Returns the output of Stan C++ ``transform_inits`` model class+        method.+      parameters:+      - description: ID of Stan model to use+        in: path+        name: model_id+        required: true+        schema:+          type: string+      requestBody:+        content:+          application/json:+            schema:+              $ref: '#/components/schemas/Data'+        description: Constrained parameter values and their specified context+        required: true+      responses:+        "200":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/_v1_models__model_id__transform_inits_post_200_response'+          description: Sequence of unconstrained parameters.+        "400":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Error associated with request.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Model not found.+      summary: Return a sequence of unconstrained parameters.+      x-codegen-request-body-name: constrained_parameters+  /v1/models/{model_id}/fits:+    post:+      description: |-+        A request to this endpoint starts a long-running operation. Users can retrieve information about the status of the operation by making a GET request to the operations resource endpoint.+        When the operation is `done`, the "fit" may be downloaded. (A "fit" collects all logger and writer messages from Stan.)+        ``function`` indicates the name of the ``stan::services function`` which should be called given the Stan model associated with the id ``model_id``. For example, if sampling using ``stan::services::sample::hmc_nuts_diag_e_adapt`` then ``function`` is the full function name ``stan::services::sample::hmc_nuts_diag_e_adapt``.  Sampler parameters which are not supplied will be given default values taken from CmdStan.  For example, if ``stan::services::sample::hmc_nuts_diag_e_adapt`` is the function called and the parameter ``num_samples`` is not specified, the value 1000 will be used. For a full list of default values consult the CmdStan documentation.+      parameters:+      - description: ID of Stan model to use+        in: path+        name: model_id+        required: true+        schema:+          type: string+      requestBody:+        content:+          application/json:+            schema:+              $ref: '#/components/schemas/CreateFitRequest'+        description: Full stan::services function name and associated arguments to+          call with Stan model.+        required: true+      responses:+        "201":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Fit'+          description: Identifier for completed Stan fit+        "400":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Error associated with request.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Fit not found.+      summary: Call function defined in stan::services.+      x-codegen-request-body-name: body+  /v1/models/{model_id}/fits/{fit_id}:+    delete:+      description: Delete a fit which has been saved in the cache.+      parameters:+      - description: ID of Stan model associated with the fit.+        in: path+        name: model_id+        required: true+        schema:+          type: string+      - description: ID of fit to be deleted.+        in: path+        name: fit_id+        required: true+        schema:+          type: string+      responses:+        "200":+          content: {}+          description: Fit successfully deleted.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Fit not found.+      summary: Delete a fit.+    get:+      description: "Result (draws, logger messages) from calling a function defined\+        \ in stan::services."+      parameters:+      - description: ID of Stan model associated with the result+        in: path+        name: model_id+        required: true+        schema:+          type: string+      - description: ID of Stan result ("fit") desired+        in: path+        name: fit_id+        required: true+        schema:+          type: string+      responses:+        "200":+          content: {}+          description: Newline-delimited JSON-encoded messages from Stan. Includes+            draws.+        "404":+          content:+            text/plain:+              schema:+                $ref: '#/components/schemas/Status'+          description: Fit not found.+      summary: Get results returned by a function.+  /v1/operations/{operation_id}:+    get:+      description: Return Operation details. Details about an Operation include whether+        or not the operation is `done` and information about the progress of sampling.+      parameters:+      - description: ID of Operation+        in: path+        name: operation_id+        required: true+        schema:+          type: string+      responses:+        "200":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Operation'+          description: Operation name and metadata.+        "404":+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/Status'+          description: Operation not found.+      summary: Get Operation details.+components:+  schemas:+    CreateFitRequest:+      example:+        random_seed: 0+        init: "{}"+        chain: 0+        data: "{}"+        max_depth: 0+        stepsize_jitter: 1.0246457001441578+        delta: 6.027456183070403+        refresh: 0+        term_buffer: 0+        init_buffer: 0+        init_radius: 5.637376656633329+        function: stan::services::sample::hmc_nuts_diag_e_adapt+        num_thin: 0+        kappa: 2.3021358869347655+        num_warmup: 0+        window: 0+        t0: 1.4894159098541704+        save_warmup: true+        gamma: 1.4658129805029452+        stepsize: 1.2315135367772556+        num_samples: 0+      properties:+        chain:+          minimum: 0+          type: integer+        data:+          allOf:+          - $ref: '#/components/schemas/Data'+          type: object+        delta:+          type: number+        function:+          enum:+          - stan::services::sample::hmc_nuts_diag_e_adapt+          - stan::services::sample::fixed_param+          type: string+        gamma:+          type: number+        init:+          allOf:+          - $ref: '#/components/schemas/Data'+          type: object+        init_buffer:+          minimum: 0+          type: integer+        init_radius:+          type: number+        kappa:+          type: number+        max_depth:+          minimum: 0+          type: integer+        num_samples:+          minimum: 0+          type: integer+        num_thin:+          minimum: 0+          type: integer+        num_warmup:+          minimum: 0+          type: integer+        random_seed:+          minimum: 0+          type: integer+        refresh:+          minimum: 0+          type: integer+        save_warmup:+          type: boolean+        stepsize:+          type: number+        stepsize_jitter:+          type: number+        t0:+          type: number+        term_buffer:+          minimum: 0+          type: integer+        window:+          minimum: 0+          type: integer+      required:+      - function+      type: object+    CreateModelRequest:+      example:+        program_code: program_code+      properties:+        program_code:+          type: string+      required:+      - program_code+      type: object+    Data:+      type: object+    Fit:+      example:+        name: name+      properties:+        name:+          type: string+      required:+      - name+      type: object+    Model:+      example:+        stanc_warnings: stanc_warnings+        compiler_output: compiler_output+        name: name+      properties:+        compiler_output:+          type: string+        name:+          type: string+        stanc_warnings:+          type: string+      required:+      - compiler_output+      - name+      - stanc_warnings+      type: object+    Operation:+      example:+        result: "{}"+        metadata: "{}"+        name: name+        done: true+      properties:+        done:+          type: boolean+        metadata:+          properties: {}+          type: object+        name:+          type: string+        result:+          properties: {}+          type: object+      required:+      - done+      - name+      type: object+    Parameter:+      example:+        dims:+        - 0+        - 0+        name: name+        constrained_names:+        - constrained_names+        - constrained_names+      properties:+        constrained_names:+          items:+            type: string+          type: array+        dims:+          items:+            type: integer+          type: array+        name:+          type: string+      required:+      - constrained_names+      - dims+      - name+      type: object+    Status:+      properties:+        code:+          type: integer+        details:+          items:+            properties: {}+            type: object+          type: array+        message:+          type: string+        status:+          type: string+      required:+      - code+      - message+      - status+      type: object+    _v1_models_get_200_response:+      example:+        models:+        - stanc_warnings: stanc_warnings+          compiler_output: compiler_output+          name: name+        - stanc_warnings: stanc_warnings+          compiler_output: compiler_output+          name: name+      properties:+        models:+          items:+            $ref: '#/components/schemas/Model'+          type: array+      type: object+    _v1_models__model_id__params_post_200_response:+      example:+        id: id+        params:+        - dims:+          - 0+          - 0+          name: name+          constrained_names:+          - constrained_names+          - constrained_names+        - dims:+          - 0+          - 0+          name: name+          constrained_names:+          - constrained_names+          - constrained_names+      properties:+        id:+          type: string+        params:+          items:+            $ref: '#/components/schemas/Parameter'+          type: array+      type: object+    _v1_models__model_id__log_prob_post_200_response:+      example:+        log_prob: 0.8008281904610115+      properties:+        log_prob:+          type: number+      type: object+    _v1_models__model_id__log_prob_grad_post_200_response:+      example:+        grad_log_prob:+        - 0.8008281904610115+        - 0.8008281904610115+      properties:+        grad_log_prob:+          items:+            type: number+          type: array+      type: object+    _v1_models__model_id__write_array_post_200_response:+      example:+        params_r_constrained:+        - 0.8008281904610115+        - 0.8008281904610115+      properties:+        params_r_constrained:+          items:+            type: number+          type: array+      type: object+    _v1_models__model_id__transform_inits_post_200_response:+      example:+        params_r_unconstrained:+        - 0.8008281904610115+        - 0.8008281904610115+      properties:+        params_r_unconstrained:+          items:+            type: number+          type: array+      type: object+x-original-swagger-version: "2.0"
+ tests/ApproxEq.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module ApproxEq where++import Data.Text (Text)+import Data.Time.Clock+import Test.QuickCheck+import GHC.Generics as G++(==~)+  :: (ApproxEq a, Show a)+  => a -> a -> Property+a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)++class GApproxEq f  where+  gApproxEq :: f a -> f a -> Bool++instance GApproxEq U1 where+  gApproxEq U1 U1 = True++instance (GApproxEq a, GApproxEq b) =>+         GApproxEq (a :+: b) where+  gApproxEq (L1 a) (L1 b) = gApproxEq a b+  gApproxEq (R1 a) (R1 b) = gApproxEq a b+  gApproxEq _ _ = False++instance (GApproxEq a, GApproxEq b) =>+         GApproxEq (a :*: b) where+  gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2++instance (ApproxEq a) =>+         GApproxEq (K1 i a) where+  gApproxEq (K1 a) (K1 b) = a =~ b++instance (GApproxEq f) =>+         GApproxEq (M1 i t f) where+  gApproxEq (M1 a) (M1 b) = gApproxEq a b++class ApproxEq a  where+  (=~) :: a -> a -> Bool+  default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool+  a =~ b = gApproxEq (G.from a) (G.from b)++instance ApproxEq Text where+  (=~) = (==)++instance ApproxEq Char where+  (=~) = (==)++instance ApproxEq Bool where+  (=~) = (==)++instance ApproxEq Int where+  (=~) = (==)++instance ApproxEq Double where+  (=~) = (==)++instance ApproxEq a =>+         ApproxEq (Maybe a)++instance ApproxEq UTCTime where+  (=~) = (==)++instance ApproxEq a =>+         ApproxEq [a] where+  as =~ bs = and (zipWith (=~) as bs)++instance (ApproxEq l, ApproxEq r) =>+         ApproxEq (Either l r) where+  Left a =~ Left b = a =~ b+  Right a =~ Right b = a =~ b+  _ =~ _ = False++instance (ApproxEq l, ApproxEq r) =>+         ApproxEq (l, r) where+  (=~) (l1, r1) (l2, r2) = l1 =~ l2 && r1 =~ r2
+ tests/Instances.hs view
@@ -0,0 +1,256 @@+{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-unused-matches #-}++module Instances where++import Httpstan.Model+import Httpstan.Core++import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy as BL+import qualified Data.HashMap.Strict as HM+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Time as TI+import qualified Data.Vector as V+import Data.String (fromString)++import Control.Monad+import Data.Char (isSpace)+import Data.List (sort)+import Test.QuickCheck++import ApproxEq++instance Arbitrary T.Text where+  arbitrary = T.pack <$> arbitrary++instance Arbitrary TI.Day where+  arbitrary = TI.ModifiedJulianDay . (2000 +) <$> arbitrary+  shrink = (TI.ModifiedJulianDay <$>) . shrink . TI.toModifiedJulianDay++instance Arbitrary TI.UTCTime where+  arbitrary =+    TI.UTCTime <$> arbitrary <*> (TI.secondsToDiffTime <$> choose (0, 86401))++instance Arbitrary BL.ByteString where+    arbitrary = BL.pack <$> arbitrary+    shrink xs = BL.pack <$> shrink (BL.unpack xs)++instance Arbitrary ByteArray where+    arbitrary = ByteArray <$> arbitrary+    shrink (ByteArray xs) = ByteArray <$> shrink xs++instance Arbitrary Binary where+    arbitrary = Binary <$> arbitrary+    shrink (Binary xs) = Binary <$> shrink xs++instance Arbitrary DateTime where+    arbitrary = DateTime <$> arbitrary+    shrink (DateTime xs) = DateTime <$> shrink xs++instance Arbitrary Date where+    arbitrary = Date <$> arbitrary+    shrink (Date xs) = Date <$> shrink xs++#if MIN_VERSION_aeson(2,0,0)+#else+-- | A naive Arbitrary instance for A.Value:+instance Arbitrary A.Value where+  arbitrary = arbitraryValue+#endif++arbitraryValue :: Gen A.Value+arbitraryValue =+  frequency [(3, simpleTypes), (1, arrayTypes), (1, objectTypes)]+    where+      simpleTypes :: Gen A.Value+      simpleTypes =+        frequency+          [ (1, return A.Null)+          , (2, liftM A.Bool (arbitrary :: Gen Bool))+          , (2, liftM (A.Number . fromIntegral) (arbitrary :: Gen Int))+          , (2, liftM (A.String . T.pack) (arbitrary :: Gen String))+          ]+      mapF (k, v) = (fromString k, v)+      simpleAndArrays = frequency [(1, sized sizedArray), (4, simpleTypes)]+      arrayTypes = sized sizedArray+      objectTypes = sized sizedObject+      sizedArray n = liftM (A.Array . V.fromList) $ replicateM n simpleTypes+      sizedObject n =+        liftM (A.object . map mapF) $+        replicateM n $ (,) <$> (arbitrary :: Gen String) <*> simpleAndArrays++-- | Checks if a given list has no duplicates in _O(n log n)_.+hasNoDups+  :: (Ord a)+  => [a] -> Bool+hasNoDups = go Set.empty+  where+    go _ [] = True+    go s (x:xs)+      | s' <- Set.insert x s+      , Set.size s' > Set.size s = go s' xs+      | otherwise = False++instance ApproxEq TI.Day where+  (=~) = (==)++arbitraryReduced :: Arbitrary a => Int -> Gen a+arbitraryReduced n = resize (n `div` 2) arbitrary++arbitraryReducedMaybe :: Arbitrary a => Int -> Gen (Maybe a)+arbitraryReducedMaybe 0 = elements [Nothing]+arbitraryReducedMaybe n = arbitraryReduced n++arbitraryReducedMaybeValue :: Int -> Gen (Maybe A.Value)+arbitraryReducedMaybeValue 0 = elements [Nothing]+arbitraryReducedMaybeValue n = do+  generated <- arbitraryReduced n+  if generated == Just A.Null+    then return Nothing+    else return generated++-- * Models++instance Arbitrary CreateFitRequest where+  arbitrary = sized genCreateFitRequest++genCreateFitRequest :: Int -> Gen CreateFitRequest+genCreateFitRequest n =+  CreateFitRequest+    <$> arbitraryReducedMaybe n -- createFitRequestChain :: Maybe Int+    <*> arbitraryReducedMaybeValue n -- createFitRequestData :: Maybe A.Value+    <*> arbitraryReducedMaybe n -- createFitRequestDelta :: Maybe Double+    <*> arbitrary -- createFitRequestFunction :: E'Function+    <*> arbitraryReducedMaybe n -- createFitRequestGamma :: Maybe Double+    <*> arbitraryReducedMaybeValue n -- createFitRequestInit :: Maybe A.Value+    <*> arbitraryReducedMaybe n -- createFitRequestInitBuffer :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestInitRadius :: Maybe Double+    <*> arbitraryReducedMaybe n -- createFitRequestKappa :: Maybe Double+    <*> arbitraryReducedMaybe n -- createFitRequestMaxDepth :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestNumSamples :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestNumThin :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestNumWarmup :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestRandomSeed :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestRefresh :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestSaveWarmup :: Maybe Bool+    <*> arbitraryReducedMaybe n -- createFitRequestStepsize :: Maybe Double+    <*> arbitraryReducedMaybe n -- createFitRequestStepsizeJitter :: Maybe Double+    <*> arbitraryReducedMaybe n -- createFitRequestT0 :: Maybe Double+    <*> arbitraryReducedMaybe n -- createFitRequestTermBuffer :: Maybe Int+    <*> arbitraryReducedMaybe n -- createFitRequestWindow :: Maybe Int+  +instance Arbitrary CreateModelRequest where+  arbitrary = sized genCreateModelRequest++genCreateModelRequest :: Int -> Gen CreateModelRequest+genCreateModelRequest n =+  CreateModelRequest+    <$> arbitrary -- createModelRequestProgramCode :: Text+  +instance Arbitrary Fit where+  arbitrary = sized genFit++genFit :: Int -> Gen Fit+genFit n =+  Fit+    <$> arbitrary -- fitName :: Text+  +instance Arbitrary Model where+  arbitrary = sized genModel++genModel :: Int -> Gen Model+genModel n =+  Model+    <$> arbitrary -- modelCompilerOutput :: Text+    <*> arbitrary -- modelName :: Text+    <*> arbitrary -- modelStancWarnings :: Text+  +instance Arbitrary Operation where+  arbitrary = sized genOperation++genOperation :: Int -> Gen Operation+genOperation n =+  Operation+    <$> arbitrary -- operationDone :: Bool+    <*> arbitraryReducedMaybeValue n -- operationMetadata :: Maybe A.Value+    <*> arbitrary -- operationName :: Text+    <*> arbitraryReducedMaybeValue n -- operationResult :: Maybe A.Value+  +instance Arbitrary Parameter where+  arbitrary = sized genParameter++genParameter :: Int -> Gen Parameter+genParameter n =+  Parameter+    <$> arbitrary -- parameterConstrainedNames :: [Text]+    <*> arbitrary -- parameterDims :: [Int]+    <*> arbitrary -- parameterName :: Text+  +instance Arbitrary Status where+  arbitrary = sized genStatus++genStatus :: Int -> Gen Status+genStatus n =+  Status+    <$> arbitrary -- statusCode :: Int+    <*> arbitraryReducedMaybe n -- statusDetails :: Maybe [A.Value]+    <*> arbitrary -- statusMessage :: Text+    <*> arbitrary -- statusStatus :: Text+  +instance Arbitrary V1ModelsGet200Response where+  arbitrary = sized genV1ModelsGet200Response++genV1ModelsGet200Response :: Int -> Gen V1ModelsGet200Response+genV1ModelsGet200Response n =+  V1ModelsGet200Response+    <$> arbitraryReducedMaybe n -- v1ModelsGet200ResponseModels :: Maybe [Model]+  +instance Arbitrary V1ModelsModelIdLogProbGradPost200Response where+  arbitrary = sized genV1ModelsModelIdLogProbGradPost200Response++genV1ModelsModelIdLogProbGradPost200Response :: Int -> Gen V1ModelsModelIdLogProbGradPost200Response+genV1ModelsModelIdLogProbGradPost200Response n =+  V1ModelsModelIdLogProbGradPost200Response+    <$> arbitraryReducedMaybe n -- v1ModelsModelIdLogProbGradPost200ResponseGradLogProb :: Maybe [Double]+  +instance Arbitrary V1ModelsModelIdLogProbPost200Response where+  arbitrary = sized genV1ModelsModelIdLogProbPost200Response++genV1ModelsModelIdLogProbPost200Response :: Int -> Gen V1ModelsModelIdLogProbPost200Response+genV1ModelsModelIdLogProbPost200Response n =+  V1ModelsModelIdLogProbPost200Response+    <$> arbitraryReducedMaybe n -- v1ModelsModelIdLogProbPost200ResponseLogProb :: Maybe Double+  +instance Arbitrary V1ModelsModelIdParamsPost200Response where+  arbitrary = sized genV1ModelsModelIdParamsPost200Response++genV1ModelsModelIdParamsPost200Response :: Int -> Gen V1ModelsModelIdParamsPost200Response+genV1ModelsModelIdParamsPost200Response n =+  V1ModelsModelIdParamsPost200Response+    <$> arbitraryReducedMaybe n -- v1ModelsModelIdParamsPost200ResponseId :: Maybe Text+    <*> arbitraryReducedMaybe n -- v1ModelsModelIdParamsPost200ResponseParams :: Maybe [Parameter]+  +instance Arbitrary V1ModelsModelIdTransformInitsPost200Response where+  arbitrary = sized genV1ModelsModelIdTransformInitsPost200Response++genV1ModelsModelIdTransformInitsPost200Response :: Int -> Gen V1ModelsModelIdTransformInitsPost200Response+genV1ModelsModelIdTransformInitsPost200Response n =+  V1ModelsModelIdTransformInitsPost200Response+    <$> arbitraryReducedMaybe n -- v1ModelsModelIdTransformInitsPost200ResponseParamsRUnconstrained :: Maybe [Double]+  +instance Arbitrary V1ModelsModelIdWriteArrayPost200Response where+  arbitrary = sized genV1ModelsModelIdWriteArrayPost200Response++genV1ModelsModelIdWriteArrayPost200Response :: Int -> Gen V1ModelsModelIdWriteArrayPost200Response+genV1ModelsModelIdWriteArrayPost200Response n =+  V1ModelsModelIdWriteArrayPost200Response+    <$> arbitraryReducedMaybe n -- v1ModelsModelIdWriteArrayPost200ResponseParamsRConstrained :: Maybe [Double]+  ++++instance Arbitrary E'Function where+  arbitrary = arbitraryBoundedEnum+
+ tests/PropMime.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++module PropMime where++import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.Monoid ((<>))+import Data.Typeable (Proxy(..), typeOf, Typeable)+import qualified Data.ByteString.Lazy.Char8 as BL8+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Property+import Test.Hspec.QuickCheck (prop)++import Httpstan.MimeTypes++import ApproxEq++-- * Type Aliases++type ArbitraryMime mime a = ArbitraryRoundtrip (MimeUnrender mime) (MimeRender mime) a++type ArbitraryRoundtrip from to a = (from a, to a, Arbitrary' a)++type Arbitrary' a = (Arbitrary a, Show a, Typeable a)++-- * Mime++propMime+  :: forall a b mime.+     (ArbitraryMime mime a, Testable b)+  => String -> (a -> a -> b) -> mime -> Proxy a -> Spec+propMime eqDescr eq m _ =+  prop+    (show (typeOf (undefined :: a)) <> " " <> show (typeOf (undefined :: mime)) <> " roundtrip " <> eqDescr) $+  \(x :: a) ->+     let rendered = mimeRender' m x+         actual = mimeUnrender' m rendered+         expected = Right x+         failMsg =+           "ACTUAL: " <> show actual <> "\nRENDERED: " <> BL8.unpack rendered+     in counterexample failMsg $+        either reject property (eq <$> actual <*> expected)+  where+    reject = property . const rejected++propMimeEq :: (ArbitraryMime mime a, Eq a) => mime -> Proxy a -> Spec+propMimeEq = propMime "(EQ)" (==)
+ tests/Test.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PartialTypeSignatures #-}++module Main where++import Data.Typeable (Proxy(..))+import Test.Hspec+import Test.Hspec.QuickCheck++import PropMime+import Instances ()++import Httpstan.Model+import Httpstan.MimeTypes++main :: IO ()+main =+  hspec $ modifyMaxSize (const 10) $ do+    describe "JSON instances" $ do+      pure ()+      propMimeEq MimeJSON (Proxy :: Proxy CreateFitRequest)+      propMimeEq MimeJSON (Proxy :: Proxy CreateModelRequest)+      propMimeEq MimeJSON (Proxy :: Proxy Fit)+      propMimeEq MimeJSON (Proxy :: Proxy Model)+      propMimeEq MimeJSON (Proxy :: Proxy Operation)+      propMimeEq MimeJSON (Proxy :: Proxy Parameter)+      propMimeEq MimeJSON (Proxy :: Proxy Status)+      propMimeEq MimeJSON (Proxy :: Proxy V1ModelsGet200Response)+      propMimeEq MimeJSON (Proxy :: Proxy V1ModelsModelIdLogProbGradPost200Response)+      propMimeEq MimeJSON (Proxy :: Proxy V1ModelsModelIdLogProbPost200Response)+      propMimeEq MimeJSON (Proxy :: Proxy V1ModelsModelIdParamsPost200Response)+      propMimeEq MimeJSON (Proxy :: Proxy V1ModelsModelIdTransformInitsPost200Response)+      propMimeEq MimeJSON (Proxy :: Proxy V1ModelsModelIdWriteArrayPost200Response)+