[haskell-http-client] update documentation; refactoring; add 'strictFields' cli option

bin/haskell-http-client-petstore.sh

@@ -28,4 +28,5 @@ fi
 export JAVA_OPTS="${JAVA_OPTS} -XX:MaxPermSize=256M -Xmx1024M -DloggerPath=conf/log4j.properties"
 ags="$@ generate -t modules/swagger-codegen/src/main/resources/haskell-http-client -i modules/swagger-codegen/src/test/resources/2_0/petstore.yaml -l haskell-http-client -o samples/client/petstore/haskell-http-client"
 
+echo "java ${JAVA_OPTS} -jar ${executable} ${ags}"
 java $JAVA_OPTS -jar $executable $ags

modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellHttpClientCodegen.java

@@ -42,7 +42,6 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
     protected String artifactId = "swagger-haskell-http-client";
     protected String artifactVersion = "1.0.0";
 
-    protected String defaultDateTimeFormat = "%Y-%m-%dT%H:%M:%S%Q%z";
     protected String defaultDateFormat = "%Y-%m-%d";
 
     // CLI
@@ -54,6 +53,7 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
     public static final String GENERATE_LENSES = "generateLenses";
     public static final String GENERATE_MODEL_CONSTRUCTORS = "generateModelConstructors";
     public static final String MODEL_DERIVING = "modelDeriving";
+    public static final String STRICT_FIELDS = "strictFields";
 
     // protected String MODEL_IMPORTS = "modelImports";
     // protected String MODEL_EXTENSIONS = "modelExtensions";
@@ -182,21 +182,22 @@ public HaskellHttpClientCodegen() {
         importMapping.clear();
         importMapping.put("Map", "qualified Data.Map as Map");
 
-        cliOptions.add(new CliOption(CodegenConstants.MODEL_PACKAGE, CodegenConstants.MODEL_PACKAGE_DESC));
-        cliOptions.add(new CliOption(CodegenConstants.API_PACKAGE, CodegenConstants.API_PACKAGE_DESC));
+        cliOptions.add(CliOption.newString(CodegenConstants.MODEL_PACKAGE, CodegenConstants.MODEL_PACKAGE_DESC));
+        cliOptions.add(CliOption.newString(CodegenConstants.API_PACKAGE, CodegenConstants.API_PACKAGE_DESC));
 
-        cliOptions.add(new CliOption(ALLOW_FROMJSON_NULLS, "allow JSON Null during model decoding from JSON").defaultValue(Boolean.TRUE.toString()));
-        cliOptions.add(new CliOption(ALLOW_TOJSON_NULLS, "allow emitting JSON Null during model encoding to JSON").defaultValue(Boolean.FALSE.toString()));
-        cliOptions.add(new CliOption(GENERATE_LENSES, "Generate Lens optics for Models").defaultValue(Boolean.TRUE.toString()));
-        cliOptions.add(new CliOption(GENERATE_MODEL_CONSTRUCTORS, "Generate smart constructors (only supply required fields) for models").defaultValue(Boolean.TRUE.toString()));
-        cliOptions.add(new CliOption(GENERATE_FORM_URLENCODED_INSTANCES, "Generate FromForm/ToForm instances for models that are used by operations that produce or consume application/x-www-form-urlencoded").defaultValue(Boolean.TRUE.toString()));
+        cliOptions.add(CliOption.newBoolean(ALLOW_FROMJSON_NULLS, "allow JSON Null during model decoding from JSON").defaultValue(Boolean.TRUE.toString()));
+        cliOptions.add(CliOption.newBoolean(ALLOW_TOJSON_NULLS, "allow emitting JSON Null during model encoding to JSON").defaultValue(Boolean.FALSE.toString()));
+        cliOptions.add(CliOption.newBoolean(GENERATE_LENSES, "Generate Lens optics for Models").defaultValue(Boolean.TRUE.toString()));
+        cliOptions.add(CliOption.newBoolean(GENERATE_MODEL_CONSTRUCTORS, "Generate smart constructors (only supply required fields) for models").defaultValue(Boolean.TRUE.toString()));
+        cliOptions.add(CliOption.newBoolean(GENERATE_FORM_URLENCODED_INSTANCES, "Generate FromForm/ToForm instances for models that are used by operations that produce or consume application/x-www-form-urlencoded").defaultValue(Boolean.TRUE.toString()));
 
-        cliOptions.add(new CliOption(MODEL_DERIVING, "Additional classes to include in the deriving() clause of Models"));
+        cliOptions.add(CliOption.newString(MODEL_DERIVING, "Additional classes to include in the deriving() clause of Models"));
+        cliOptions.add(CliOption.newBoolean(STRICT_FIELDS, "Add strictness annotations to all model fields").defaultValue((Boolean.FALSE.toString())));
 
-        cliOptions.add(new CliOption(DATETIME_FORMAT, "format string used to parse/render a datetime").defaultValue(defaultDateTimeFormat));
-        cliOptions.add(new CliOption(DATE_FORMAT, "format string used to parse/render a date").defaultValue(defaultDateFormat));
+        cliOptions.add(CliOption.newString(DATETIME_FORMAT, "format string used to parse/render a datetime"));
+        cliOptions.add(CliOption.newString(DATE_FORMAT, "format string used to parse/render a date").defaultValue(defaultDateFormat));
 
-        cliOptions.add(new CliOption(CodegenConstants.HIDE_GENERATION_TIMESTAMP, "hides the timestamp when files were generated").defaultValue(Boolean.TRUE.toString()));
+        cliOptions.add(CliOption.newBoolean(CodegenConstants.HIDE_GENERATION_TIMESTAMP, "hides the timestamp when files were generated").defaultValue(Boolean.TRUE.toString()));
 
         // cliOptions.add(new CliOption(MODEL_IMPORTS, "Additional imports in the Models file"));
         // cliOptions.add(new CliOption(MODEL_EXTENSIONS, "Additional extensions in the Models file"));
@@ -241,12 +242,16 @@ public void setDateTimeFormat(String value) {
 
     public void setDateFormat(String value) {
         if (StringUtils.isBlank(value)) {
-            additionalProperties.put(DATE_FORMAT, defaultDateFormat);
+            additionalProperties.remove(DATE_FORMAT);
         } else {
             additionalProperties.put(DATE_FORMAT, value);
         }
     }
 
+    public void setStrictFields(Boolean value) {
+        additionalProperties.put("x-strictFields", value);
+    }
+
     @Override
     public void processOpts() {
         super.processOpts();
@@ -296,13 +301,19 @@ public void processOpts() {
         if (additionalProperties.containsKey(DATETIME_FORMAT)) {
             setDateTimeFormat(additionalProperties.get(DATETIME_FORMAT).toString());
         } else {
-            setDateTimeFormat(null);
+            setDateTimeFormat(null); // default should be null
         }
 
         if (additionalProperties.containsKey(DATE_FORMAT)) {
             setDateFormat(additionalProperties.get(DATE_FORMAT).toString());
         } else {
-            setDateFormat(null);
+            setDateFormat(defaultDateFormat);
+        }
+
+        if (additionalProperties.containsKey(STRICT_FIELDS)) {
+            setStrictFields(convertPropertyToBoolean(STRICT_FIELDS));
+        } else {
+            setStrictFields(false);
         }
 
     }

modules/swagger-codegen/src/main/resources/haskell-http-client/API.mustache

@@ -11,13 +11,15 @@ Module : {{title}}.API
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE InstanceSigs #-}
-{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-imports #-}
 
 module {{title}}.API where
 
 
 import {{title}}.Model as M
 import {{title}}.MimeTypes
+import {{title}}.Lens
 
 import qualified Data.Aeson as A
 import Data.Aeson (Value)
@@ -52,6 +54,8 @@ import qualified Data.Text.Lazy.Encoding as TL
 import qualified GHC.Base as P (Alternative)
 import qualified Control.Arrow as P (left)
 
+import qualified Lens.Micro as L
+
 import Data.Monoid ((<>))
 import Data.Function ((&))
 import Data.Set (Set)
@@ -144,11 +148,26 @@ newtype {{{vendorExtensions.x-paramNameType}}} = {{{vendorExtensions.x-paramName
 -- | Represents a request. The "req" type variable is the request type. The "res" type variable is the response type.
 data {{requestType}} req contentType res = {{requestType}}
   { rMethod  :: NH.Method   -- ^ Method of {{requestType}}
-  , urlPath :: [BCL.ByteString] -- ^ Endpoint of {{requestType}}
-  , params   :: Params -- ^ params of {{requestType}}
+  , rUrlPath :: [BCL.ByteString] -- ^ Endpoint of {{requestType}}
+  , rParams   :: Params -- ^ params of {{requestType}}
   }
   deriving (P.Show)
 
+-- | 'rMethod' Lens
+rMethodL :: Lens_' ({{requestType}} req contentType res) NH.Method
+rMethodL f {{requestType}}{..} = (\rMethod -> {{requestType}} { rMethod, ..} ) <$> f rMethod
+{-# INLINE rMethodL #-}
+
+-- | 'rUrlPath' Lens
+rUrlPathL :: Lens_' ({{requestType}} req contentType res) [BCL.ByteString]
+rUrlPathL f {{requestType}}{..} = (\rUrlPath -> {{requestType}} { rUrlPath, ..} ) <$> f rUrlPath
+{-# INLINE rUrlPathL #-}
+
+-- | 'rParams' Lens
+rParamsL :: Lens_' ({{requestType}} req contentType res) Params
+rParamsL f {{requestType}}{..} = (\rParams -> {{requestType}} { rParams, ..} ) <$> f rParams
+{-# INLINE rParamsL #-}
+
 -- | Request Params
 data Params = Params
   { paramsQuery :: NH.Query
@@ -157,6 +176,21 @@ data Params = Params
   }
   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
@@ -177,15 +211,18 @@ _mkParams :: Params
 _mkParams = Params [] [] ParamBodyNone
 
 setHeader :: {{requestType}} req contentType res -> [NH.Header] -> {{requestType}} req contentType res
-setHeader req header = 
-    let _params = params (req `removeHeader` P.fmap P.fst header)
-    in req { params = _params { paramsHeaders = header P.++ paramsHeaders _params } }
+setHeader req header =
+  req `removeHeader` P.fmap P.fst header &
+  L.over (rParamsL . paramsHeadersL) (header P.++)
 
 removeHeader :: {{requestType}} req contentType res -> [NH.HeaderName] -> {{requestType}} req contentType res
-removeHeader req header = 
-    let _params = params req
-    in req { params = _params { paramsHeaders = [h | h <- paramsHeaders _params, cifst h `P.notElem` P.fmap CI.mk header] } }
-  where cifst = CI.mk . P.fst
+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. MimeType contentType => {{requestType}} req contentType res -> {{requestType}} req contentType res
@@ -202,35 +239,34 @@ _setAcceptHeader req accept =
 
 _setQuery :: {{requestType}} req contentType res -> [NH.QueryItem] -> {{requestType}} req contentType res
 _setQuery req query = 
-    let _params = params req 
-    in req { params = _params { paramsQuery = query P.++ [q | q <- paramsQuery _params, cifst q `P.notElem` P.fmap cifst query] } }
-  where cifst = CI.mk . P.fst
+  req &
+  L.over
+    (rParamsL . paramsQueryL)
+    ((query P.++) . P.filter (\q -> cifst q `P.notElem` P.fmap cifst query))
+  where
+    cifst = CI.mk . P.fst
 
 _addForm :: {{requestType}} req contentType res -> WH.Form -> {{requestType}} req contentType res
 _addForm req newform = 
-    let _params = params req
-        form = case paramsBody _params of
+    let form = case paramsBody (rParams req) of
             ParamBodyFormUrlEncoded _form -> _form
             _ -> mempty
-    in req { params = _params { paramsBody = ParamBodyFormUrlEncoded (newform <> form) } }
+    in req & L.set (rParamsL . paramsBodyL) (ParamBodyFormUrlEncoded (newform <> form))
 
 _addMultiFormPart :: {{requestType}} req contentType res -> NH.Part -> {{requestType}} req contentType res
 _addMultiFormPart req newpart = 
-    let _params = params req
-        parts = case paramsBody _params of
+    let parts = case paramsBody (rParams req) of
             ParamBodyMultipartFormData _parts -> _parts
             _ -> []
-    in req { params = _params { paramsBody = ParamBodyMultipartFormData (newpart : parts) } }
+    in req & L.set (rParamsL . paramsBodyL) (ParamBodyMultipartFormData (newpart : parts))
 
 _setBodyBS :: {{requestType}} req contentType res -> B.ByteString -> {{requestType}} req contentType res
 _setBodyBS req body = 
-    let _params = params req
-    in req { params = _params { paramsBody = ParamBodyB body } }
+    req & L.set (rParamsL . paramsBodyL) (ParamBodyB body)
 
 _setBodyLBS :: {{requestType}} req contentType res -> BL.ByteString -> {{requestType}} req contentType res
 _setBodyLBS req body = 
-    let _params = params req
-    in req { params = _params { paramsBody = ParamBodyBL body } }
+    req & L.set (rParamsL . paramsBodyL) (ParamBodyBL body)
 
 
 -- ** Params Utils

modules/swagger-codegen/src/main/resources/haskell-http-client/Client.mustache

@@ -225,15 +225,15 @@ _toInitRequest
   -> accept -- ^ "accept" 'MimeType'
   -> IO (InitRequest req contentType res accept) -- ^ initialized request
 _toInitRequest config req0 accept = do
-  parsedReq <- NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (urlPath req0))
+  parsedReq <- NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (rUrlPath req0))
   let req1 = _setAcceptHeader req0 accept & _setContentTypeHeader
-      reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders (params req1)
-      reqQuery = NH.renderQuery True (paramsQuery (params req1))
+      reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders (rParams req1)
+      reqQuery = NH.renderQuery True (paramsQuery (rParams req1))
       pReq = parsedReq { NH.method = (rMethod req1)
                        , NH.requestHeaders = reqHeaders
                        , NH.queryString = reqQuery
                        }
-  outReq <- case paramsBody (params req1) of
+  outReq <- case paramsBody (rParams req1) 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 })

modules/swagger-codegen/src/main/resources/haskell-http-client/Model.mustache

@@ -2,7 +2,6 @@
 Module : {{title}}.Model
 -}
 
-{-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE DeriveFoldable #-}
 {-# LANGUAGE DeriveGeneric #-}
@@ -58,7 +57,7 @@ import qualified Prelude as P
 -- {{{.}}}{{/description}}
 {{^vendorExtensions.x-customNewtype}}
 data {{classname}} = {{classname}}
-  { {{#vars}}{{name}} :: {{^required}}Maybe {{/required}}{{datatype}} -- ^ {{#required}}/Required/ {{/required}}{{#readOnly}}/ReadOnly/ {{/readOnly}}"{{baseName}}"{{#description}} - {{description}}{{/description}}{{#hasMore}}
+  { {{#vars}}{{name}} :: {{#x-strictFields}}!({{/x-strictFields}}{{^required}}Maybe {{/required}}{{datatype}}{{#x-strictFields}}){{/x-strictFields}} -- ^ {{#required}}/Required/ {{/required}}{{#readOnly}}/ReadOnly/ {{/readOnly}}"{{baseName}}"{{#description}} - {{description}}{{/description}}{{#hasMore}}
   , {{/hasMore}}{{/vars}}
   } deriving (P.Show,P.Eq,P.Typeable{{#modelDeriving}},{{modelDeriving}}{{/modelDeriving}})
 

modules/swagger-codegen/src/main/resources/haskell-http-client/README.mustache

@@ -50,17 +50,20 @@ haskell-http-client
 
     - use `setHeader` to add any required headers to requests
 
+* Model Inheritance
+
 * Default Parameter Values
 
 * Enum Parameters
 
+
 This is beta software; other cases may not be supported.
 
-### Codegen "config option" parameters
+### Codegen "additional properties" parameters
 
 These options allow some customization of the code generation process.
 
-**haskell-http-client specific options:**
+**haskell-http-client additional properties:**
 
 | OPTION                          | DESCRIPTION                                                                                                                   | DEFAULT  | ACTUAL                                |
 | ------------------------------- | ----------------------------------------------------------------------------------------------------------------------------- | -------- | ------------------------------------- |
@@ -72,15 +75,23 @@ These options allow some customization of the code generation process.
 | generateLenses                  | Generate Lens optics for Models                                                                                               | true     | {{{generateLenses}}}                  |
 | generateModelConstructors       | Generate smart constructors (only supply required fields) for models                                                          | true     | {{{generateModelConstructors}}}       |
 | modelDeriving                   | Additional classes to include in the deriving() clause of Models                                                              |          | {{{modelDeriving}}}                   |
+| strictFields                    | Add strictness annotations to all model fields                                                                                | false    | {{{x-strictFields}}}                  |
 
 [1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis
 
+An example setting _strictFields_ and _dateTimeFormat_:
+
+```
+java -jar swagger-codegen-cli.jar generate -i petstore.yaml -l haskell-http-client -o output/haskell-http-client -DstrictFields=true -DdateTimeFormat="%Y-%m-%dT%H:%M:%S%Q%z"
+```
+
 View the full list of Codegen "config option" parameters with the command:
 
 ```
-java -jar modules/swagger-codegen-cli/target/swagger-codegen-cli.jar config-help -l haskell-http-client
+java -jar swagger-codegen-cli.jar config-help -l haskell-http-client
 ```
 
+
 ### Example SwaggerPetstore Haddock documentation 
 
 An example of the generated haddock documentation targeting the server http://petstore.swagger.io/ (SwaggerPetstore) can be found [here][2]

modules/swagger-codegen/src/main/resources/haskell-http-client/TopLevel.mustache

@@ -7,11 +7,11 @@ module {{title}}
   , module {{title}}.API
   , module {{title}}.Model
   , module {{title}}.MimeTypes
-  , {{#generateLenses}}module {{title}}.Lens{{/generateLenses}}
+  , module {{title}}.Lens
   ) where
 
 import {{title}}.API
 import {{title}}.Client
 import {{title}}.Model
 import {{title}}.MimeTypes
-{{#generateLenses}}import {{title}}.Lens{{/generateLenses}}
+import {{title}}.Lens

modules/swagger-codegen/src/main/resources/haskell-http-client/haskell-http-client.cabal.mustache

@@ -57,13 +57,14 @@ library
     , monad-logger >=0.3 && <0.4
     , safe-exceptions <0.2
     , case-insensitive
+    , microlens >= 0.4.3 && <0.5
   exposed-modules:
       {{title}}
       {{title}}.API
       {{title}}.Client
       {{title}}.Model
       {{title}}.MimeTypes
-      {{#generateLenses}}{{title}}.Lens{{/generateLenses}}
+      {{title}}.Lens
   other-modules:
       Paths_{{pathsName}}
   default-language: Haskell2010

modules/swagger-codegen/src/main/resources/haskell-http-client/package.mustache

@@ -36,16 +36,18 @@ dependencies:
 - transformers >=0.4.0.0
 - mtl >=2.2.1
 - unordered-containers
+ghc-options: -Wall
 library:
   source-dirs: lib
-  ghc-options: -Wall
+  ghc-options:
+  {{#x-strictFields}}- -funbox-strict-fields{{/x-strictFields}}
   exposed-modules:
   - {{title}}
   - {{title}}.API
   - {{title}}.Client
   - {{title}}.Model
   - {{title}}.MimeTypes
-  {{#generateLenses}}- {{title}}.Lens{{/generateLenses}}
+  - {{title}}.Lens
   dependencies:
   - aeson >=1.0 && <2.0
   - bytestring >=0.10.0 && <0.11
@@ -65,6 +67,7 @@ library:
   - monad-logger >=0.3 && <0.4
   - safe-exceptions <0.2
   - case-insensitive
+  - microlens >= 0.4.3 && <0.5
 tests:
   tests:
     main: Test.hs

modules/swagger-codegen/src/main/resources/haskell-http-client/tests/Instances.mustache

@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-warn-unused-imports #-}
+
 module Instances where
 
 import Data.Text (Text, pack)