diff --git a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellHttpClientCodegen.java b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellHttpClientCodegen.java
index a7cc41fd230..037af1b7787 100644
--- a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellHttpClientCodegen.java
+++ b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellHttpClientCodegen.java
@@ -44,6 +44,8 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
protected String defaultDateFormat = "%Y-%m-%d";
+ protected Boolean useMonadLogger = false;
+
// CLI
public static final String ALLOW_FROMJSON_NULLS = "allowFromJsonNulls";
public static final String ALLOW_TOJSON_NULLS = "allowToJsonNulls";
@@ -54,6 +56,7 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
public static final String GENERATE_MODEL_CONSTRUCTORS = "generateModelConstructors";
public static final String MODEL_DERIVING = "modelDeriving";
public static final String STRICT_FIELDS = "strictFields";
+ public static final String USE_MONAD_LOGGER = "useMonadLogger";
// protected String MODEL_IMPORTS = "modelImports";
// protected String MODEL_EXTENSIONS = "modelExtensions";
@@ -192,7 +195,8 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
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(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(CliOption.newBoolean(STRICT_FIELDS, "Add strictness annotations to all model fields").defaultValue((Boolean.TRUE.toString())));
+ cliOptions.add(CliOption.newBoolean(USE_MONAD_LOGGER, "Use the monad-logger package to provide logging (if false, use the katip logging package)").defaultValue((Boolean.FALSE.toString())));
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));
@@ -252,6 +256,11 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
additionalProperties.put("x-strictFields", value);
}
+ public void setUseMonadLogger(Boolean value) {
+ additionalProperties.put("x-useMonadLogger", value);
+ this.useMonadLogger = value;
+ }
+
@Override
public void processOpts() {
super.processOpts();
@@ -313,7 +322,12 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
if (additionalProperties.containsKey(STRICT_FIELDS)) {
setStrictFields(convertPropertyToBoolean(STRICT_FIELDS));
} else {
- setStrictFields(false);
+ setStrictFields(true);
+ }
+ if (additionalProperties.containsKey(USE_MONAD_LOGGER)) {
+ setUseMonadLogger(convertPropertyToBoolean(USE_MONAD_LOGGER));
+ } else {
+ setUseMonadLogger(false);
}
}
@@ -366,9 +380,6 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
// root
supportingFiles.add(new SupportingFile("haskell-http-client.cabal.mustache", "", cabalName + ".cabal"));
- supportingFiles.add(new SupportingFile("haskell-http-client.cabal.mustache", "", cabalName + ".cabal"));
- supportingFiles.add(new SupportingFile("package.mustache", "", "package.yaml"));
-
// lib
supportingFiles.add(new SupportingFile("TopLevel.mustache", "lib/", apiName + ".hs"));
supportingFiles.add(new SupportingFile("Client.mustache", "lib/" + apiName, "Client.hs"));
@@ -377,6 +388,9 @@ public class HaskellHttpClientCodegen extends DefaultCodegen implements CodegenC
supportingFiles.add(new SupportingFile("Model.mustache", "lib/" + apiName, "Model.hs"));
supportingFiles.add(new SupportingFile("MimeTypes.mustache", "lib/" + apiName, "MimeTypes.hs"));
+ // logger
+ supportingFiles.add(new SupportingFile(useMonadLogger ? "LoggingMonadLogger.mustache" : "LoggingKatip.mustache", "lib/" + apiName, "Logging.hs"));
+
// modelTemplateFiles.put("API.mustache", ".hs");
// apiTemplateFiles.put("Model.mustache", ".hs");
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/Client.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/Client.mustache
index f23f0ebf1dd..68228e22bbb 100644
--- a/modules/swagger-codegen/src/main/resources/haskell-http-client/Client.mustache
+++ b/modules/swagger-codegen/src/main/resources/haskell-http-client/Client.mustache
@@ -17,6 +17,7 @@ module {{title}}.Client where
import {{title}}.Model
import {{title}}.API
import {{title}}.MimeTypes
+import {{title}}.Logging
import qualified Control.Monad.IO.Class as P
import qualified Data.Aeson as A
@@ -30,8 +31,6 @@ import Web.FormUrlEncoded as WH
import Web.HttpApiData as WH
import Control.Monad.Catch (MonadThrow)
-import qualified Control.Monad.Logger as LG
-
import qualified Data.Time as TI
import qualified Data.Map as Map
import qualified Data.Text as T
@@ -57,8 +56,8 @@ import qualified Control.Exception.Safe as E
data {{configType}} = {{configType}}
{ configHost :: BCL.ByteString -- ^ host supplied in the Request
, configUserAgent :: Text -- ^ user-agent supplied in the Request
- , configExecLoggingT :: ExecLoggingT -- ^ Run a block using a MonadLogger instance
- , configLoggingFilter :: LG.LogSource -> LG.LogLevel -> Bool -- ^ Only log messages passing the given predicate function.
+ , configLogExecWithContext :: LogExecWithContext -- ^ Run a block using a Logger instance
+ , configLogContext :: LogContext -- ^ Configures the logger
}
-- | display the config
@@ -79,29 +78,29 @@ instance Show {{configType}} where
--
-- @"{{#httpUserAgent}}{{{.}}}{{/httpUserAgent}}{{^httpUserAgent}}{{{artifactId}}}/{{{artifactVersion}}}{{/httpUserAgent}}"@
--
--- configExecLoggingT: 'runNullLoggingT'
---
--- configLoggingFilter: 'infoLevelFilter'
-newConfig :: {{configType}}
-newConfig =
- {{configType}}
- { configHost = "{{basePath}}"
- , configUserAgent = "{{#httpUserAgent}}{{{.}}}{{/httpUserAgent}}{{^httpUserAgent}}{{{artifactId}}}/{{{artifactVersion}}}{{/httpUserAgent}}"
- , configExecLoggingT = runNullLoggingT
- , configLoggingFilter = infoLevelFilter
- }
+newConfig :: IO {{configType}}
+newConfig = do
+ logCxt <- initLogContext
+ return $ SwaggerPetstoreConfig
+ { configHost = "{{{basePath}}}"
+ , configUserAgent = "{{#httpUserAgent}}{{{.}}}{{/httpUserAgent}}{{^httpUserAgent}}{{{artifactId}}}/{{{artifactVersion}}}{{/httpUserAgent}}"
+ , configLogExecWithContext = runDefaultLogExecWithContext
+ , configLogContext = logCxt
+ }
--- | updates the config to use a MonadLogger instance which prints to stdout.
-withStdoutLogging :: {{configType}} -> {{configType}}
-withStdoutLogging p = p { configExecLoggingT = LG.runStdoutLoggingT}
+withStdoutLogging :: {{configType}} -> IO {{configType}}
+withStdoutLogging p = do
+ logCxt <- stdoutLoggingContext (configLogContext p)
+ return $ p { configLogExecWithContext = stdoutLoggingExec, configLogContext = logCxt }
--- | updates the config to use a MonadLogger instance which prints to stderr.
-withStderrLogging :: {{configType}} -> {{configType}}
-withStderrLogging p = p { configExecLoggingT = LG.runStderrLoggingT}
+withStderrLogging :: {{configType}} -> IO {{configType}}
+withStderrLogging p = do
+ logCxt <- stderrLoggingContext (configLogContext p)
+ return $ p { configLogExecWithContext = stderrLoggingExec, configLogContext = logCxt }
-- | updates the config to disable logging
withNoLogging :: {{configType}} -> {{configType}}
-withNoLogging p = p { configExecLoggingT = runNullLoggingT}
+withNoLogging p = p { configLogExecWithContext = runNullLogExec}
-- * Dispatch
@@ -146,10 +145,10 @@ dispatchMime
dispatchMime manager config request accept = do
httpResponse <- dispatchLbs manager config request accept
parsedResult <-
- runExceptionLoggingT "Client" config $
+ runConfigLogWithExceptions "Client" config $
do case mimeUnrender' accept (NH.responseBody httpResponse) of
Left s -> do
- logNST LG.LevelError "Client" (T.pack s)
+ _log "Client" levelError (T.pack s)
pure (Left (MimeError s httpResponse))
Right r -> pure (Right r)
return (MimeResult parsedResult httpResponse)
@@ -187,15 +186,15 @@ dispatchInitUnsafe
-> InitRequest req contentType res accept -- ^ init request
-> IO (NH.Response BCL.ByteString) -- ^ response
dispatchInitUnsafe manager config (InitRequest req) = do
- runExceptionLoggingT logSrc config $
- do logNST LG.LevelInfo logSrc requestLogMsg
- logNST LG.LevelDebug logSrc requestDbgLogMsg
+ runConfigLogWithExceptions src config $
+ do _log src levelInfo requestLogMsg
+ _log src levelDebug requestDbgLogMsg
res <- P.liftIO $ NH.httpLbs req manager
- logNST LG.LevelInfo logSrc (responseLogMsg res)
- logNST LG.LevelDebug logSrc ((T.pack . show) res)
+ _log src levelInfo (responseLogMsg res)
+ _log src levelDebug ((T.pack . show) res)
return res
where
- logSrc = "Client"
+ src = "Client"
endpoint =
T.pack $
BC.unpack $
@@ -250,68 +249,16 @@ modifyInitRequest (InitRequest req) f = InitRequest (f req)
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
-
--- | A block using a MonadLogger instance
-type ExecLoggingT = forall m. P.MonadIO m =>
- forall a. LG.LoggingT m a -> m a
-
--- ** Null Logger
-
--- | a logger which disables logging
-nullLogger :: LG.Loc -> LG.LogSource -> LG.LogLevel -> LG.LogStr -> IO ()
-nullLogger _ _ _ _ = return ()
-
--- | run the monad transformer that disables logging
-runNullLoggingT :: LG.LoggingT m a -> m a
-runNullLoggingT = (`LG.runLoggingT` nullLogger)
-
--- ** Logging Filters
-
--- | a log filter that uses 'LevelError' as the minimum logging level
-errorLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool
-errorLevelFilter = minLevelFilter LG.LevelError
-
--- | a log filter that uses 'LevelInfo' as the minimum logging level
-infoLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool
-infoLevelFilter = minLevelFilter LG.LevelInfo
-
--- | a log filter that uses 'LevelDebug' as the minimum logging level
-debugLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool
-debugLevelFilter = minLevelFilter LG.LevelDebug
-
-minLevelFilter :: LG.LogLevel -> LG.LogSource -> LG.LogLevel -> Bool
-minLevelFilter l _ l' = l' >= l
-
-- ** Logging
--- | Log a message using the current time
-logNST :: (P.MonadIO m, LG.MonadLogger m) => LG.LogLevel -> Text -> Text -> m ()
-logNST level src msg = do
- now <- P.liftIO (formatTimeLog <$> TI.getCurrentTime)
- LG.logOtherNS sourceLog level (now <> " " <> msg)
- where
- sourceLog = "{{title}}/" <> src
- formatTimeLog =
- T.pack . TI.formatTime TI.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Z"
+-- | Run a block using the configured logger instance
+runConfigLog
+ :: P.MonadIO m
+ => {{configType}} -> LogExec m
+runConfigLog config = configLogExecWithContext config (configLogContext config)
--- | 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
- logNST LG.LevelError src ((T.pack . show) e)
- E.throw e)
-
--- | Run a block using the configured MonadLogger instance
-runLoggingT :: {{configType}} -> ExecLoggingT
-runLoggingT config =
- configExecLoggingT config . LG.filterLogger (configLoggingFilter config)
-
--- | Run a block using the configured MonadLogger instance (logs exceptions)
-runExceptionLoggingT
+-- | Run a block using the configured logger instance (logs exceptions)
+runConfigLogWithExceptions
:: (E.MonadCatch m, P.MonadIO m)
- => T.Text -> {{configType}} -> LG.LoggingT m a -> m a
-runExceptionLoggingT logSrc config = runLoggingT config . logExceptions logSrc
+ => T.Text -> {{configType}} -> LogExec m
+runConfigLogWithExceptions src config = runConfigLog config . logExceptions src
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/LoggingKatip.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/LoggingKatip.mustache
new file mode 100644
index 00000000000..470df933b09
--- /dev/null
+++ b/modules/swagger-codegen/src/main/resources/haskell-http-client/LoggingKatip.mustache
@@ -0,0 +1,108 @@
+{-|
+Module : {{title}}.Logging
+Katip Logging functions
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module {{title}}.Logging where
+
+import Data.Text (Text)
+import GHC.Exts (IsString(..))
+
+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 qualified Katip as LG
+
+-- * Type Aliases (for compatability)
+
+-- | Runs a Katip logging block with the Log environment
+type LogExecWithContext = forall m. P.MonadIO m =>
+ LogContext -> LogExec m
+
+-- | A Katip logging block
+type LogExec m = forall 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 "{{title}}" "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.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.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
+
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/LoggingMonadLogger.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/LoggingMonadLogger.mustache
new file mode 100644
index 00000000000..a9737b70e01
--- /dev/null
+++ b/modules/swagger-codegen/src/main/resources/haskell-http-client/LoggingMonadLogger.mustache
@@ -0,0 +1,117 @@
+{-|
+Module : {{title}}.Logging
+monad-logger Logging functions
+-}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module {{title}}.Logging where
+
+import Data.Text (Text)
+
+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.Monoid ((<>))
+
+import qualified Control.Monad.Logger as LG
+
+-- * Type Aliases (for compatability)
+
+-- | Runs a monad-logger block with the filter predicate
+type LogExecWithContext = forall m. P.MonadIO m =>
+ LogContext -> LogExec m
+
+-- | A monad-logger block
+type LogExec m = forall 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 ("{{title}}." <> 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
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/Model.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/Model.mustache
index 17b1b55827f..9176a1e047d 100644
--- a/modules/swagger-codegen/src/main/resources/haskell-http-client/Model.mustache
+++ b/modules/swagger-codegen/src/main/resources/haskell-http-client/Model.mustache
@@ -64,7 +64,7 @@ data {{classname}} = {{classname}}
instance A.FromJSON {{classname}} where
parseJSON = A.withObject "{{classname}}" $ \o ->
{{classname}}
- <$>{{#vars}} (o {{#required}}.: {{/required}}{{^required}}{{^allowFromJsonNulls}}.:!{{/allowFromJsonNulls}}{{#allowFromJsonNulls}}.:?{{/allowFromJsonNulls}}{{/required}} "{{baseName}}"{{#isDateTime}} >>={{^required}} P.mapM{{/required}} _readDateTime{{/isDateTime}}{{#isDate}} >>={{^required}} P.mapM{{/required}} _showDate{{/isDate}}){{#hasMore}}
+ <$>{{#vars}} (o {{#required}}.: {{/required}}{{^required}}{{^allowFromJsonNulls}}.:!{{/allowFromJsonNulls}}{{#allowFromJsonNulls}}.:?{{/allowFromJsonNulls}}{{/required}} "{{baseName}}"{{#isDateTime}} >>={{^required}} P.mapM{{/required}} _readDateTime{{/isDateTime}}{{#isDate}} >>={{^required}} P.mapM{{/required}} _readDate{{/isDate}}){{#hasMore}}
<*>{{/hasMore}}{{/vars}}
instance A.ToJSON {{classname}} where
@@ -78,7 +78,7 @@ instance A.ToJSON {{classname}} where
instance WH.FromForm {{classname}} where
fromForm f =
{{classname}}
- <$>{{#vars}} ({{#required}}WH.parseUnique {{/required}}{{^required}}WH.parseMaybe {{/required}}"{{baseName}}" f{{#isDateTime}} >>={{^required}} P.mapM{{/required}} _readDateTime{{/isDateTime}}{{#isDate}} >>={{^required}} P.mapM{{/required}} _showDate{{/isDate}}){{#hasMore}}
+ <$>{{#vars}} ({{#required}}WH.parseUnique {{/required}}{{^required}}WH.parseMaybe {{/required}}"{{baseName}}" f{{#isDateTime}} >>={{^required}} P.mapM{{/required}} _readDateTime{{/isDateTime}}{{#isDate}} >>={{^required}} P.mapM{{/required}} _readDate{{/isDate}}){{#hasMore}}
<*>{{/hasMore}}{{/vars}}
instance WH.ToForm {{classname}} where
@@ -166,4 +166,4 @@ _readDate =
_showDate :: TI.FormatTime t => t -> String
_showDate =
TI.formatTime TI.defaultTimeLocale "{{{dateFormat}}}"
-{-# INLINE _showDate #-}
\ No newline at end of file
+{-# INLINE _showDate #-}
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/README.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/README.mustache
index 028941e3ae7..1b1db613a2d 100644
--- a/modules/swagger-codegen/src/main/resources/haskell-http-client/README.mustache
+++ b/modules/swagger-codegen/src/main/resources/haskell-http-client/README.mustache
@@ -75,7 +75,8 @@ 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}}} |
+| strictFields | Add strictness annotations to all model fields | true | {{{x-strictFields}}} |
+| useMonadLogger | Use the monad-logger package to provide logging (if instead false, use the katip logging package) | false | {{{x-useMonadLogger}}} |
[1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis
@@ -115,6 +116,7 @@ This library is intended to be imported qualified.
| {{title}}.Model | describes models |
| {{title}}.MimeTypes | encoding/decoding MIME types (content-types/accept) |
| {{title}}.Lens | lenses for model fields |
+| {{title}}.Logging | logging functions and utils |
This library adds type safety around what swagger specifies as
Produces and Consumes for each Operation (e.g. the list of MIME types an
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/TopLevel.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/TopLevel.mustache
index 3cbf6cd3630..83e2c8ed979 100644
--- a/modules/swagger-codegen/src/main/resources/haskell-http-client/TopLevel.mustache
+++ b/modules/swagger-codegen/src/main/resources/haskell-http-client/TopLevel.mustache
@@ -8,6 +8,7 @@ module {{title}}
, module {{title}}.Model
, module {{title}}.MimeTypes
, module {{title}}.Lens
+ , module {{title}}.Logging
) where
import {{title}}.API
@@ -15,3 +16,4 @@ import {{title}}.Client
import {{title}}.Model
import {{title}}.MimeTypes
import {{title}}.Lens
+import {{title}}.Logging
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/haskell-http-client.cabal.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/haskell-http-client.cabal.mustache
index 0f1f9f28a6a..1125ab040da 100644
--- a/modules/swagger-codegen/src/main/resources/haskell-http-client/haskell-http-client.cabal.mustache
+++ b/modules/swagger-codegen/src/main/resources/haskell-http-client/haskell-http-client.cabal.mustache
@@ -8,6 +8,8 @@ synopsis: Auto-generated {{package}} API Client
description: .
Client library for calling the {{package}} API based on http-client.
.
+ host: {{host}}
+ .
base path: {{basePath}}
.
apiVersion: {{apiVersion}}
@@ -17,6 +19,7 @@ description: .
{{^hideGenerationTimestamp}}Generated on: {{generatedDate}}
.
{{/hideGenerationTimestamp}}OpenAPI-Specification: https://github.com/OAI/OpenAPI-Specification/blob/master/versions/{{swaggerVersion}}.md
+ .
category: Web
homepage: https://github.com/swagger-api/swagger-codegen#readme
author: Author Name Here
@@ -33,7 +36,7 @@ extra-source-files:
library
hs-source-dirs:
lib
- ghc-options: -Wall
+ ghc-options: -Wall -funbox-strict-fields
build-depends:
base >=4.7 && <5.0
, transformers >=0.4.0.0
@@ -54,7 +57,7 @@ library
, network >=2.6.2 && <2.7
, random >=1.1
, exceptions >= 0.4
- , monad-logger >=0.3 && <0.4
+ , {{^x-useMonadLogger}}katip >=0.4 && < 0.6{{/x-useMonadLogger}}{{#x-useMonadLogger}}monad-logger >=0.3 && <0.4{{/x-useMonadLogger}}
, safe-exceptions <0.2
, case-insensitive
, microlens >= 0.4.3 && <0.5
@@ -65,6 +68,7 @@ library
{{title}}.Model
{{title}}.MimeTypes
{{title}}.Lens
+ {{title}}.Logging
other-modules:
Paths_{{pathsName}}
default-language: Haskell2010
@@ -74,7 +78,7 @@ test-suite tests
main-is: Test.hs
hs-source-dirs:
tests
- ghc-options: -fno-warn-orphans
+ ghc-options: -Wall -fno-warn-orphans
build-depends:
base >=4.7 && <5.0
, transformers >=0.4.0.0
diff --git a/modules/swagger-codegen/src/main/resources/haskell-http-client/package.mustache b/modules/swagger-codegen/src/main/resources/haskell-http-client/package.mustache
deleted file mode 100644
index 23b18b7c6ce..00000000000
--- a/modules/swagger-codegen/src/main/resources/haskell-http-client/package.mustache
+++ /dev/null
@@ -1,87 +0,0 @@
-name: {{package}}
-version: '0.1.0.0'
-synopsis: Auto-generated {{package}} API Client
-description: ! '
-
- Client library for calling the {{package}} API based on http-client.
-
- host: {{host}}
-
-
- base path: {{basePath}}
-
-
- apiVersion: {{apiVersion}}
-
-
- swagger version: {{swaggerVersion}}
-
-
- {{^hideGenerationTimestamp}}Generated on: {{generatedDate}}
-
-
- {{/hideGenerationTimestamp}}OpenAPI-Specification: https://github.com/OAI/OpenAPI-Specification/blob/master/versions/{{swaggerVersion}}.md
-'
-category: Web
-author: Author Name Here
-maintainer: author.name@email.com
-copyright: YEAR - AUTHOR
-license: UnspecifiedLicense
-homepage: https://github.com/swagger-api/swagger-codegen#readme
-extra-source-files:
-- README.md
-- swagger.json
-dependencies:
-- base >=4.7 && <5.0
-- transformers >=0.4.0.0
-- mtl >=2.2.1
-- unordered-containers
-ghc-options: -Wall
-library:
- source-dirs: lib
- ghc-options:
- {{#x-strictFields}}- -funbox-strict-fields{{/x-strictFields}}
- exposed-modules:
- - {{title}}
- - {{title}}.API
- - {{title}}.Client
- - {{title}}.Model
- - {{title}}.MimeTypes
- - {{title}}.Lens
- dependencies:
- - aeson >=1.0 && <2.0
- - bytestring >=0.10.0 && <0.11
- - containers >=0.5.0.0 && <0.6
- - http-types >=0.8 && <0.10
- - http-client >=0.5 && <0.6
- - http-client-tls
- - http-api-data >= 0.3.4 && <0.4
- - http-media >= 0.4 && < 0.8
- - text >=0.11 && <1.3
- - time >=1.5 && <1.9
- - iso8601-time >=0.1.3 && <0.2.0
- - vector >=0.10.9 && <0.13
- - network >=2.6.2 && <2.7
- - random >=1.1
- - exceptions >= 0.4
- - monad-logger >=0.3 && <0.4
- - safe-exceptions <0.2
- - case-insensitive
- - microlens >= 0.4.3 && <0.5
-tests:
- tests:
- main: Test.hs
- source-dirs: tests
- ghc-options:
- - -fno-warn-orphans
- dependencies:
- - {{package}}
- - bytestring >=0.10.0 && <0.11
- - containers
- - hspec >=1.8
- - text
- - time
- - iso8601-time
- - aeson
- - semigroups
- - QuickCheck
diff --git a/modules/swagger-codegen/src/test/java/io/swagger/codegen/haskellhttpclient/HaskellHttpClientOptionsTest.java b/modules/swagger-codegen/src/test/java/io/swagger/codegen/haskellhttpclient/HaskellHttpClientOptionsTest.java
index 98d583fbd11..fbd99027bfd 100644
--- a/modules/swagger-codegen/src/test/java/io/swagger/codegen/haskellhttpclient/HaskellHttpClientOptionsTest.java
+++ b/modules/swagger-codegen/src/test/java/io/swagger/codegen/haskellhttpclient/HaskellHttpClientOptionsTest.java
@@ -49,6 +49,8 @@ public class HaskellHttpClientOptionsTest extends AbstractOptionsTest {
times = 1;
clientCodegen.setStrictFields(Boolean.valueOf(HaskellHttpClientOptionsProvider.STRICT_FIELDS));
times = 1;
+ clientCodegen.setUseMonadLogger(Boolean.valueOf(HaskellHttpClientOptionsProvider.USE_MONAD_LOGGER));
+ times = 1;
}};
}
diff --git a/modules/swagger-codegen/src/test/java/io/swagger/codegen/options/HaskellHttpClientOptionsProvider.java b/modules/swagger-codegen/src/test/java/io/swagger/codegen/options/HaskellHttpClientOptionsProvider.java
index d124c66ff54..4695069a53d 100644
--- a/modules/swagger-codegen/src/test/java/io/swagger/codegen/options/HaskellHttpClientOptionsProvider.java
+++ b/modules/swagger-codegen/src/test/java/io/swagger/codegen/options/HaskellHttpClientOptionsProvider.java
@@ -23,6 +23,7 @@ public class HaskellHttpClientOptionsProvider implements OptionsProvider {
public static final String GENERATE_FORM_URLENCODED_INSTANCES = "true";
public static final String GENERATE_LENSES = "true";
public static final String GENERATE_MODEL_CONSTRUCTORS = "true";
+ public static final String USE_MONAD_LOGGER = "false";
@Override
public String getLanguage() {
@@ -48,6 +49,7 @@ public class HaskellHttpClientOptionsProvider implements OptionsProvider {
.put(HaskellHttpClientCodegen.GENERATE_LENSES, GENERATE_LENSES)
.put(HaskellHttpClientCodegen.GENERATE_MODEL_CONSTRUCTORS, GENERATE_MODEL_CONSTRUCTORS)
.put(HaskellHttpClientCodegen.STRICT_FIELDS, STRICT_FIELDS)
+ .put(HaskellHttpClientCodegen.USE_MONAD_LOGGER, USE_MONAD_LOGGER)
.build();
}
diff --git a/samples/client/petstore/haskell-http-client/CONTRIBUTING.md b/samples/client/petstore/haskell-http-client/CONTRIBUTING.md
index 91fbe58305b..4d86a160843 100644
--- a/samples/client/petstore/haskell-http-client/CONTRIBUTING.md
+++ b/samples/client/petstore/haskell-http-client/CONTRIBUTING.md
@@ -17,9 +17,10 @@
2. Check that the following commands complete build without any errors
```bash
- (stack clean && stack haddock && stack test);
- (cd ./example-app; stack clean && stack build);
- (cd ./tests-integration; stack clean && stack build --no-run-tests);
+ (rm -Rf ./.stack-work ./example-app/.stack-work ./tests-integration/.stack-work);
+ (stack haddock && stack test);
+ (cd ./example-app; stack build);
+ (cd ./tests-integration; stack build --no-run-tests);
```
### Integration Tests
diff --git a/samples/client/petstore/haskell-http-client/README.md b/samples/client/petstore/haskell-http-client/README.md
index 35ac99a323a..cfbe72747d8 100644
--- a/samples/client/petstore/haskell-http-client/README.md
+++ b/samples/client/petstore/haskell-http-client/README.md
@@ -75,7 +75,8 @@ These options allow some customization of the code generation process.
| generateLenses | Generate Lens optics for Models | true | true |
| generateModelConstructors | Generate smart constructors (only supply required fields) for models | true | true |
| modelDeriving | Additional classes to include in the deriving() clause of Models | | |
-| strictFields | Add strictness annotations to all model fields | false | false |
+| strictFields | Add strictness annotations to all model fields | true | true |
+| useMonadLogger | Use the monad-logger package to provide logging (if instead false, use the katip logging package) | false | false |
[1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis
@@ -115,6 +116,7 @@ This library is intended to be imported qualified.
| SwaggerPetstore.Model | describes models |
| SwaggerPetstore.MimeTypes | encoding/decoding MIME types (content-types/accept) |
| SwaggerPetstore.Lens | lenses for model fields |
+| SwaggerPetstore.Logging | logging functions and utils |
This library adds type safety around what swagger specifies as
Produces and Consumes for each Operation (e.g. the list of MIME types an
diff --git a/samples/client/petstore/haskell-http-client/docs/SwaggerPetstore-Client.html b/samples/client/petstore/haskell-http-client/docs/SwaggerPetstore-Client.html
index 5be560eab09..54087571b77 100644
--- a/samples/client/petstore/haskell-http-client/docs/SwaggerPetstore-Client.html
+++ b/samples/client/petstore/haskell-http-client/docs/SwaggerPetstore-Client.html
@@ -1,4 +1,4 @@
SwaggerPetstore.ClientSynopsis
- data SwaggerPetstoreConfig = SwaggerPetstoreConfig {}
- newConfig :: SwaggerPetstoreConfig
- withStdoutLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig
- withStderrLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig
- withNoLogging :: SwaggerPetstoreConfig -> SwaggerPetstoreConfig
- dispatchLbs :: (Produces req accept, MimeType contentType) => Manager -> SwaggerPetstoreConfig -> SwaggerPetstoreRequest req contentType res -> accept -> IO (Response ByteString)
- data MimeResult res = MimeResult {}
- data MimeError = MimeError {}
- dispatchMime :: (Produces req accept, MimeUnrender accept res, MimeType contentType) => Manager -> SwaggerPetstoreConfig -> SwaggerPetstoreRequest req contentType res -> accept -> IO (MimeResult res)
- dispatchMime' :: (Produces req accept, MimeUnrender accept res, MimeType contentType) => Manager -> SwaggerPetstoreConfig -> SwaggerPetstoreRequest req contentType res -> accept -> IO (Either MimeError res)
- dispatchLbsUnsafe :: (MimeType accept, MimeType contentType) => Manager -> SwaggerPetstoreConfig -> SwaggerPetstoreRequest req contentType res -> accept -> IO (Response ByteString)
- dispatchInitUnsafe :: Manager -> SwaggerPetstoreConfig -> InitRequest req contentType res accept -> IO (Response ByteString)
- newtype InitRequest req contentType res accept = InitRequest {}
- _toInitRequest :: (MimeType accept, MimeType contentType) => SwaggerPetstoreConfig -> SwaggerPetstoreRequest req contentType res -> accept -> IO (InitRequest req contentType res accept)
- modifyInitRequest :: InitRequest req contentType res accept -> (Request -> Request) -> InitRequest req contentType res accept
- modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (Request -> m Request) -> m (InitRequest req contentType res accept)
- type ExecLoggingT = forall m. MonadIO m => forall a. LoggingT m a -> m a
- nullLogger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
- runNullLoggingT :: LoggingT m a -> m a
- errorLevelFilter :: LogSource -> LogLevel -> Bool
- infoLevelFilter :: LogSource -> LogLevel -> Bool
- debugLevelFilter :: LogSource -> LogLevel -> Bool
- minLevelFilter :: LogLevel -> LogSource -> LogLevel -> Bool
- logNST :: (MonadIO m, MonadLogger m) => LogLevel -> Text -> Text -> m ()
- logExceptions :: (MonadLogger m, MonadCatch m, MonadIO m) => Text -> m a -> m a
- runLoggingT :: SwaggerPetstoreConfig -> ExecLoggingT
- runExceptionLoggingT :: (MonadCatch m, MonadIO m) => Text -> SwaggerPetstoreConfig -> LoggingT m a -> m a
Config
Dispatch
Lbs
Mime
Unsafe
dispatchLbsUnsafe Source #
like dispatchReqLbs
, but does not validate the operation is a Producer
of the "accept" MimeType
. (Useful if the server's response is undocumented)
InitRequest
newtype InitRequest req contentType res accept Source #
wraps an http-client Request
with request/response type parameters
Logging
Null Logger
Logging Filters
Logging
\ No newline at end of file
+Config
Dispatch
Lbs
Mime
Unsafe
dispatchLbsUnsafe Source #
like dispatchReqLbs
, but does not validate the operation is a Producer
of the "accept" MimeType
. (Useful if the server's response is undocumented)
InitRequest
newtype InitRequest req contentType res accept Source #
wraps an http-client Request
with request/response type parameters
Logging