{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module serves the purpose of defining common functionality which remains the same across all OpenAPI specifications.
module OpenAPI.Common
  ( doCallWithConfiguration,
    doCallWithConfigurationM,
    doBodyCallWithConfiguration,
    doBodyCallWithConfigurationM,
    runWithConfiguration,
    textToByte,
    byteToText,
    stringifyModel,
    anonymousSecurityScheme,
    jsonObjectToList,
    Configuration (..),
    SecurityScheme,
    MonadHTTP (..),
    JsonByteString (..),
    JsonDateTime (..),
    RequestBodyEncoding (..),
    QueryParameter (..),
    Nullable (..),
    ClientT (..),
    ClientM,
  )
where

import qualified Control.Monad.IO.Class as MIO
import qualified Control.Monad.Reader as MR
import qualified Control.Monad.Trans.Class as MT
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding as Encoding
import Data.Aeson.Text (encodeToTextBuilder)
import qualified Data.Bifunctor as BF
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Maybe as Maybe
import qualified Data.Scientific as Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Text.Encoding.Error (lenientDecode)
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import qualified Data.Time.LocalTime as Time
import qualified Data.Vector as Vector
import qualified Network.HTTP.Client as HC
import qualified Network.HTTP.Simple as HS
import qualified Network.HTTP.Types as HT

#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as Key
import qualified Data.Aeson.KeyMap as KeyMap
#else
import qualified Data.HashMap.Strict as HMap
#endif

-- | Abstracts the usage of 'Network.HTTP.Simple.httpBS' away,
--  so that it can be used for testing
class (Monad m) => MonadHTTP m where
  httpBS :: HS.Request -> m (HS.Response BS.ByteString)

-- | This instance is the default instance used for production code
instance MonadHTTP IO where
  httpBS :: Request -> IO (Response ByteString)
httpBS = Request -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> m (Response ByteString)
HS.httpBS

instance (MonadHTTP m) => MonadHTTP (MR.ReaderT r m) where
  httpBS :: Request -> ReaderT r m (Response ByteString)
httpBS = m (Response ByteString) -> ReaderT r m (Response ByteString)
forall (m :: * -> *) a. Monad m => m a -> ReaderT r m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> ReaderT r m (Response ByteString))
-> (Request -> m (Response ByteString))
-> Request
-> ReaderT r m (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS

instance (MonadHTTP m) => MonadHTTP (ClientT m) where
  httpBS :: Request -> ClientT m (Response ByteString)
httpBS = m (Response ByteString) -> ClientT m (Response ByteString)
forall (m :: * -> *) a. Monad m => m a -> ClientT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> ClientT m (Response ByteString))
-> (Request -> m (Response ByteString))
-> Request
-> ClientT m (Response ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS

-- | The monad in which the operations can be run.
-- Contains the 'Configuration' to run the requests with.
--
-- Run it with 'runWithConfiguration'
newtype ClientT m a = ClientT (MR.ReaderT Configuration m a)
  deriving ((forall a b. (a -> b) -> ClientT m a -> ClientT m b)
-> (forall a b. a -> ClientT m b -> ClientT m a)
-> Functor (ClientT m)
forall a b. a -> ClientT m b -> ClientT m a
forall a b. (a -> b) -> ClientT m a -> ClientT m b
forall (m :: * -> *) a b.
Functor m =>
a -> ClientT m b -> ClientT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ClientT m a -> ClientT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> ClientT m a -> ClientT m b
fmap :: forall a b. (a -> b) -> ClientT m a -> ClientT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> ClientT m b -> ClientT m a
<$ :: forall a b. a -> ClientT m b -> ClientT m a
Functor, Functor (ClientT m)
Functor (ClientT m) =>
(forall a. a -> ClientT m a)
-> (forall a b. ClientT m (a -> b) -> ClientT m a -> ClientT m b)
-> (forall a b c.
    (a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c)
-> (forall a b. ClientT m a -> ClientT m b -> ClientT m b)
-> (forall a b. ClientT m a -> ClientT m b -> ClientT m a)
-> Applicative (ClientT m)
forall a. a -> ClientT m a
forall a b. ClientT m a -> ClientT m b -> ClientT m a
forall a b. ClientT m a -> ClientT m b -> ClientT m b
forall a b. ClientT m (a -> b) -> ClientT m a -> ClientT m b
forall a b c.
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *). Applicative m => Functor (ClientT m)
forall (m :: * -> *) a. Applicative m => a -> ClientT m a
forall (m :: * -> *) a b.
Applicative m =>
ClientT m a -> ClientT m b -> ClientT m a
forall (m :: * -> *) a b.
Applicative m =>
ClientT m a -> ClientT m b -> ClientT m b
forall (m :: * -> *) a b.
Applicative m =>
ClientT m (a -> b) -> ClientT m a -> ClientT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
$cpure :: forall (m :: * -> *) a. Applicative m => a -> ClientT m a
pure :: forall a. a -> ClientT m a
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
ClientT m (a -> b) -> ClientT m a -> ClientT m b
<*> :: forall a b. ClientT m (a -> b) -> ClientT m a -> ClientT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
liftA2 :: forall a b c.
(a -> b -> c) -> ClientT m a -> ClientT m b -> ClientT m c
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
ClientT m a -> ClientT m b -> ClientT m b
*> :: forall a b. ClientT m a -> ClientT m b -> ClientT m b
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
ClientT m a -> ClientT m b -> ClientT m a
<* :: forall a b. ClientT m a -> ClientT m b -> ClientT m a
Applicative, Applicative (ClientT m)
Applicative (ClientT m) =>
(forall a b. ClientT m a -> (a -> ClientT m b) -> ClientT m b)
-> (forall a b. ClientT m a -> ClientT m b -> ClientT m b)
-> (forall a. a -> ClientT m a)
-> Monad (ClientT m)
forall a. a -> ClientT m a
forall a b. ClientT m a -> ClientT m b -> ClientT m b
forall a b. ClientT m a -> (a -> ClientT m b) -> ClientT m b
forall (m :: * -> *). Monad m => Applicative (ClientT m)
forall (m :: * -> *) a. Monad m => a -> ClientT m a
forall (m :: * -> *) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m b
forall (m :: * -> *) a b.
Monad m =>
ClientT m a -> (a -> ClientT m b) -> ClientT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
ClientT m a -> (a -> ClientT m b) -> ClientT m b
>>= :: forall a b. ClientT m a -> (a -> ClientT m b) -> ClientT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
ClientT m a -> ClientT m b -> ClientT m b
>> :: forall a b. ClientT m a -> ClientT m b -> ClientT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> ClientT m a
return :: forall a. a -> ClientT m a
Monad, MR.MonadReader Configuration)

instance MT.MonadTrans ClientT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> ClientT m a
lift = ReaderT Configuration m a -> ClientT m a
forall (m :: * -> *) a. ReaderT Configuration m a -> ClientT m a
ClientT (ReaderT Configuration m a -> ClientT m a)
-> (m a -> ReaderT Configuration m a) -> m a -> ClientT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT Configuration m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Configuration m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift

instance (MIO.MonadIO m) => MIO.MonadIO (ClientT m) where
  liftIO :: forall a. IO a -> ClientT m a
liftIO = ReaderT Configuration m a -> ClientT m a
forall (m :: * -> *) a. ReaderT Configuration m a -> ClientT m a
ClientT (ReaderT Configuration m a -> ClientT m a)
-> (IO a -> ReaderT Configuration m a) -> IO a -> ClientT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> ReaderT Configuration m a
forall a. IO a -> ReaderT Configuration m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO

-- | Utility type which uses 'IO' as underlying monad
type ClientM a = ClientT IO a

-- | Run a 'ClientT' monad transformer in another monad with a specified configuration
runWithConfiguration :: Configuration -> ClientT m a -> m a
runWithConfiguration :: forall (m :: * -> *) a. Configuration -> ClientT m a -> m a
runWithConfiguration Configuration
c (ClientT ReaderT Configuration m a
r) = ReaderT Configuration m a -> Configuration -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MR.runReaderT ReaderT Configuration m a
r Configuration
c

-- | An operation can and must be configured with data, which may be common
-- for many operations.
--
-- This configuration consists of information about the server URL and the used security scheme.
--
-- In OpenAPI these information can be defined
--
-- * Root level
-- * Path level
-- * Operation level
--
-- To get started, the 'OpenAPI.Configuration.defaultConfiguration' can be used and changed accordingly.
--
-- Note that it is possible that @bearerAuthenticationSecurityScheme@ is not available because it is not a security scheme in the OpenAPI specification.
--
-- > defaultConfiguration
-- >   { configSecurityScheme = bearerAuthenticationSecurityScheme "token" }
data Configuration = Configuration
  { -- | The path of the operation is appended to this URL
    Configuration -> Text
configBaseURL :: Text,
    -- | The 'SecurityScheme' which is applied to the request
    -- This is used to set the @Authentication@ header for example
    Configuration -> SecurityScheme
configSecurityScheme :: SecurityScheme,
    -- | This flag indicates if an automatically generated @User-Agent@ header
    -- should be added to the request. This allows the server to detect with
    -- which version of the generator the code was generated.
    Configuration -> Bool
configIncludeUserAgent :: Bool,
    -- | The application name which will be included in the @User-Agent@ header
    -- if 'configIncludeUserAgent' is set to 'True'
    Configuration -> Text
configApplicationName :: Text
  }

-- | Defines how a request body is encoded
data RequestBodyEncoding
  = -- | Encode the body as JSON
    RequestBodyEncodingJSON
  | -- | Encode the body as form data
    RequestBodyEncodingFormData

-- | Defines a query parameter with the information necessary for serialization
data QueryParameter = QueryParameter
  { QueryParameter -> Text
queryParamName :: Text,
    QueryParameter -> Maybe Value
queryParamValue :: Maybe Aeson.Value,
    QueryParameter -> Text
queryParamStyle :: Text,
    QueryParameter -> Bool
queryParamExplode :: Bool
  }
  deriving (Int -> QueryParameter -> ShowS
[QueryParameter] -> ShowS
QueryParameter -> String
(Int -> QueryParameter -> ShowS)
-> (QueryParameter -> String)
-> ([QueryParameter] -> ShowS)
-> Show QueryParameter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryParameter -> ShowS
showsPrec :: Int -> QueryParameter -> ShowS
$cshow :: QueryParameter -> String
show :: QueryParameter -> String
$cshowList :: [QueryParameter] -> ShowS
showList :: [QueryParameter] -> ShowS
Show, QueryParameter -> QueryParameter -> Bool
(QueryParameter -> QueryParameter -> Bool)
-> (QueryParameter -> QueryParameter -> Bool) -> Eq QueryParameter
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryParameter -> QueryParameter -> Bool
== :: QueryParameter -> QueryParameter -> Bool
$c/= :: QueryParameter -> QueryParameter -> Bool
/= :: QueryParameter -> QueryParameter -> Bool
Eq)

-- | This type specifies a security scheme which can modify a request according to the scheme (e. g. add an Authorization header)
type SecurityScheme = HS.Request -> HS.Request

-- | Anonymous security scheme which does not alter the request in any way
anonymousSecurityScheme :: SecurityScheme
anonymousSecurityScheme :: SecurityScheme
anonymousSecurityScheme = SecurityScheme
forall a. a -> a
id

-- | This is the main functionality of this module
--
--   It makes a concrete Call to a Server without a body
doCallWithConfiguration ::
  (MonadHTTP m) =>
  -- | Configuration options like base URL and security scheme
  Configuration ->
  -- | HTTP method (GET, POST, etc.)
  Text ->
  -- | Path to append to the base URL (path parameters should already be replaced)
  Text ->
  -- | Query parameters
  [QueryParameter] ->
  -- | The raw response from the server
  m (HS.Response BS.ByteString)
doCallWithConfiguration :: forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
doCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams =
  Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS (Request -> m (Response ByteString))
-> Request -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams

-- | Same as 'doCallWithConfiguration' but run in a 'MR.ReaderT' environment which contains the configuration.
-- This is useful if multiple calls have to be executed with the same configuration.
doCallWithConfigurationM ::
  (MonadHTTP m) =>
  Text ->
  Text ->
  [QueryParameter] ->
  ClientT m (HS.Response BS.ByteString)
doCallWithConfigurationM :: forall (m :: * -> *).
MonadHTTP m =>
Text -> Text -> [QueryParameter] -> ClientT m (Response ByteString)
doCallWithConfigurationM Text
method Text
path [QueryParameter]
queryParams = do
  Configuration
config <- ClientT m Configuration
forall r (m :: * -> *). MonadReader r m => m r
MR.ask
  m (Response ByteString) -> ClientT m (Response ByteString)
forall (m :: * -> *) a. Monad m => m a -> ClientT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> ClientT m (Response ByteString))
-> m (Response ByteString) -> ClientT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
doCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams

-- | This is the main functionality of this module
--
--   It makes a concrete Call to a Server with a body
doBodyCallWithConfiguration ::
  (MonadHTTP m, Aeson.ToJSON body) =>
  -- | Configuration options like base URL and security scheme
  Configuration ->
  -- | HTTP method (GET, POST, etc.)
  Text ->
  -- | Path to append to the base URL (path parameters should already be replaced)
  Text ->
  -- | Query parameters
  [QueryParameter] ->
  -- | Request body
  Maybe body ->
  -- | JSON or form data deepobjects
  RequestBodyEncoding ->
  -- | The raw response from the server
  m (HS.Response BS.ByteString)
doBodyCallWithConfiguration :: forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Configuration
-> Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> m (Response ByteString)
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams Maybe body
Nothing RequestBodyEncoding
_ = Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Configuration
-> Text -> Text -> [QueryParameter] -> m (Response ByteString)
doCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams (Just body
body) RequestBodyEncoding
RequestBodyEncodingJSON =
  Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS (Request -> m (Response ByteString))
-> Request -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> SecurityScheme
HS.setRequestMethod (Text -> ByteString
textToByte Text
method) SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$ body -> SecurityScheme
forall a. ToJSON a => a -> SecurityScheme
HS.setRequestBodyJSON body
body Request
baseRequest
  where
    baseRequest :: Request
baseRequest = Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams (Just body
body) RequestBodyEncoding
RequestBodyEncodingFormData =
  Request -> m (Response ByteString)
forall (m :: * -> *).
MonadHTTP m =>
Request -> m (Response ByteString)
httpBS (Request -> m (Response ByteString))
-> Request -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> SecurityScheme
HS.setRequestMethod (Text -> ByteString
textToByte Text
method) SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> SecurityScheme
HS.setRequestBodyURLEncoded [(ByteString, ByteString)]
byteStringData Request
baseRequest
  where
    baseRequest :: Request
baseRequest = Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams
    byteStringData :: [(ByteString, ByteString)]
byteStringData = body -> [(ByteString, ByteString)]
forall a. ToJSON a => a -> [(ByteString, ByteString)]
createFormData body
body

-- | Same as 'doBodyCallWithConfiguration' but run in a 'MR.ReaderT' environment which contains the configuration.
-- This is useful if multiple calls have to be executed with the same configuration.
doBodyCallWithConfigurationM ::
  (MonadHTTP m, Aeson.ToJSON body) =>
  Text ->
  Text ->
  [QueryParameter] ->
  Maybe body ->
  RequestBodyEncoding ->
  ClientT m (HS.Response BS.ByteString)
doBodyCallWithConfigurationM :: forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> ClientT m (Response ByteString)
doBodyCallWithConfigurationM Text
method Text
path [QueryParameter]
queryParams Maybe body
body RequestBodyEncoding
encoding = do
  Configuration
config <- ClientT m Configuration
forall r (m :: * -> *). MonadReader r m => m r
MR.ask
  m (Response ByteString) -> ClientT m (Response ByteString)
forall (m :: * -> *) a. Monad m => m a -> ClientT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (m (Response ByteString) -> ClientT m (Response ByteString))
-> m (Response ByteString) -> ClientT m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Configuration
-> Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> m (Response ByteString)
forall (m :: * -> *) body.
(MonadHTTP m, ToJSON body) =>
Configuration
-> Text
-> Text
-> [QueryParameter]
-> Maybe body
-> RequestBodyEncoding
-> m (Response ByteString)
doBodyCallWithConfiguration Configuration
config Text
method Text
path [QueryParameter]
queryParams Maybe body
body RequestBodyEncoding
encoding

-- | Creates a Base Request
createBaseRequest ::
  -- | Configuration options like base URL and security scheme
  Configuration ->
  -- | HTTP method (GET, POST, etc.)
  Text ->
  -- | The path for which the placeholders have already been replaced
  Text ->
  -- | Query Parameters
  [QueryParameter] ->
  -- | The Response from the server
  HS.Request
createBaseRequest :: Configuration -> Text -> Text -> [QueryParameter] -> Request
createBaseRequest Configuration
config Text
method Text
path [QueryParameter]
queryParams =
  Configuration -> SecurityScheme
configSecurityScheme Configuration
config SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$
    SecurityScheme
addUserAgent SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$
      ByteString -> SecurityScheme
HS.setRequestMethod (Text -> ByteString
textToByte Text
method) SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$
        Query -> SecurityScheme
HS.setRequestQueryString Query
query SecurityScheme -> SecurityScheme
forall a b. (a -> b) -> a -> b
$
          ByteString -> SecurityScheme
HS.setRequestPath
            (Text -> ByteString
textToByte (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
basePathModifier Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
path)
            Request
baseRequest
  where
    baseRequest :: Request
baseRequest = Text -> Request
parseURL (Text -> Request) -> Text -> Request
forall a b. (a -> b) -> a -> b
$ Configuration -> Text
configBaseURL Configuration
config
    basePath :: Text
basePath = ByteString -> Text
byteToText (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ Request -> ByteString
HC.path Request
baseRequest
    basePathModifier :: Text
basePathModifier =
      if Text
basePath Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"/" Bool -> Bool -> Bool
&& Text -> Text -> Bool
T.isPrefixOf Text
"/" Text
path
        then Text
""
        else Text
basePath
    -- filters all maybe
    query :: Query
query = (ByteString -> Maybe ByteString)
-> (ByteString, ByteString) -> (ByteString, Maybe ByteString)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
BF.second ByteString -> Maybe ByteString
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ByteString, ByteString) -> (ByteString, Maybe ByteString))
-> [(ByteString, ByteString)] -> Query
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [QueryParameter] -> [(ByteString, ByteString)]
serializeQueryParams [QueryParameter]
queryParams
    userAgent :: Text
userAgent = Configuration -> Text
configApplicationName Configuration
config Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" openapi3-code-generator/VERSION_TO_REPLACE (https://github.com/Haskell-OpenAPI-Code-Generator/Haskell-OpenAPI-Client-Code-Generator)"
    addUserAgent :: SecurityScheme
addUserAgent =
      if Configuration -> Bool
configIncludeUserAgent Configuration
config
        then HeaderName -> ByteString -> SecurityScheme
HS.addRequestHeader HeaderName
HT.hUserAgent (ByteString -> SecurityScheme) -> ByteString -> SecurityScheme
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
textToByte Text
userAgent
        else SecurityScheme
forall a. a -> a
id

serializeQueryParams :: [QueryParameter] -> [(BS.ByteString, BS.ByteString)]
serializeQueryParams :: [QueryParameter] -> [(ByteString, ByteString)]
serializeQueryParams = ([QueryParameter]
-> (QueryParameter -> [(ByteString, ByteString)])
-> [(ByteString, ByteString)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= QueryParameter -> [(ByteString, ByteString)]
serializeQueryParam)

serializeQueryParam :: QueryParameter -> [(BS.ByteString, BS.ByteString)]
serializeQueryParam :: QueryParameter -> [(ByteString, ByteString)]
serializeQueryParam QueryParameter {Bool
Maybe Value
Text
queryParamName :: QueryParameter -> Text
queryParamValue :: QueryParameter -> Maybe Value
queryParamStyle :: QueryParameter -> Text
queryParamExplode :: QueryParameter -> Bool
queryParamName :: Text
queryParamValue :: Maybe Value
queryParamStyle :: Text
queryParamExplode :: Bool
..} =
  let concatValues :: BS.ByteString -> [(Maybe Text, BS.ByteString)] -> [(Text, BS.ByteString)]
      concatValues :: ByteString -> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
joinWith =
        if Bool
queryParamExplode
          then ((Maybe Text, ByteString) -> (Text, ByteString))
-> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe Text -> Text)
-> (Maybe Text, ByteString) -> (Text, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first ((Maybe Text -> Text)
 -> (Maybe Text, ByteString) -> (Text, ByteString))
-> (Maybe Text -> Text)
-> (Maybe Text, ByteString)
-> (Text, ByteString)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
Maybe.fromMaybe Text
queryParamName)
          else
            (Text, ByteString) -> [(Text, ByteString)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
              ((Text, ByteString) -> [(Text, ByteString)])
-> ([(Maybe Text, ByteString)] -> (Text, ByteString))
-> [(Maybe Text, ByteString)]
-> [(Text, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text
queryParamName,)
              (ByteString -> (Text, ByteString))
-> ([(Maybe Text, ByteString)] -> ByteString)
-> [(Maybe Text, ByteString)]
-> (Text, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
joinWith
              ([ByteString] -> ByteString)
-> ([(Maybe Text, ByteString)] -> [ByteString])
-> [(Maybe Text, ByteString)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Text, ByteString) -> ByteString)
-> [(Maybe Text, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                ( \case
                    (Maybe Text
Nothing, ByteString
value) -> ByteString
value
                    (Just Text
name, ByteString
value) -> Text -> ByteString
textToByte Text
name ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
joinWith ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
value
                )
   in (Text -> ByteString)
-> (Text, ByteString) -> (ByteString, ByteString)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first Text -> ByteString
textToByte ((Text, ByteString) -> (ByteString, ByteString))
-> [(Text, ByteString)] -> [(ByteString, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case Maybe Value
queryParamValue of
        Maybe Value
Nothing -> []
        Just Value
value ->
          ( case Text
queryParamStyle of
              Text
"form" -> ByteString -> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
","
              Text
"spaceDelimited" -> ByteString -> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
" "
              Text
"pipeDelimited" -> ByteString -> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
concatValues ByteString
"|"
              Text
"deepObject" -> [(Text, ByteString)]
-> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
forall a b. a -> b -> a
const ([(Text, ByteString)]
 -> [(Maybe Text, ByteString)] -> [(Text, ByteString)])
-> [(Text, ByteString)]
-> [(Maybe Text, ByteString)]
-> [(Text, ByteString)]
forall a b. (a -> b) -> a -> b
$ (Text -> ByteString) -> (Text, Text) -> (Text, ByteString)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
BF.second Text -> ByteString
textToByte ((Text, Text) -> (Text, ByteString))
-> [(Text, Text)] -> [(Text, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed Text
queryParamName Value
value
              Text
_ -> [(Text, ByteString)]
-> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
forall a b. a -> b -> a
const []
          )
            ([(Maybe Text, ByteString)] -> [(Text, ByteString)])
-> [(Maybe Text, ByteString)] -> [(Text, ByteString)]
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Value -> [(Maybe Text, ByteString)]
jsonToFormDataFlat Maybe Text
forall a. Maybe a
Nothing Value
value

encodeStrict :: (Aeson.ToJSON a) => a -> BS.ByteString
encodeStrict :: forall a. ToJSON a => a -> ByteString
encodeStrict = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode

jsonToFormDataFlat :: Maybe Text -> Aeson.Value -> [(Maybe Text, BS.ByteString)]
jsonToFormDataFlat :: Maybe Text -> Value -> [(Maybe Text, ByteString)]
jsonToFormDataFlat Maybe Text
_ Value
Aeson.Null = []
jsonToFormDataFlat Maybe Text
name (Aeson.Number Scientific
a) = [(Maybe Text
name, Scientific -> ByteString
forall a. ToJSON a => a -> ByteString
encodeStrict Scientific
a)]
jsonToFormDataFlat Maybe Text
name (Aeson.String Text
a) = [(Maybe Text
name, Text -> ByteString
textToByte Text
a)]
jsonToFormDataFlat Maybe Text
name (Aeson.Bool Bool
a) = [(Maybe Text
name, Bool -> ByteString
forall a. ToJSON a => a -> ByteString
encodeStrict Bool
a)]
jsonToFormDataFlat Maybe Text
_ (Aeson.Object Object
object) = Object -> [(Text, Value)]
forall v. KeyMap v -> [(Text, v)]
jsonObjectToList Object
object [(Text, Value)]
-> ((Text, Value) -> [(Maybe Text, ByteString)])
-> [(Maybe Text, ByteString)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe Text -> Value -> [(Maybe Text, ByteString)])
-> (Maybe Text, Value) -> [(Maybe Text, ByteString)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Maybe Text -> Value -> [(Maybe Text, ByteString)]
jsonToFormDataFlat ((Maybe Text, Value) -> [(Maybe Text, ByteString)])
-> ((Text, Value) -> (Maybe Text, Value))
-> (Text, Value)
-> [(Maybe Text, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe Text) -> (Text, Value) -> (Maybe Text, Value)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first Text -> Maybe Text
forall a. a -> Maybe a
Just
jsonToFormDataFlat Maybe Text
name (Aeson.Array Array
vector) = Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
vector [Value]
-> (Value -> [(Maybe Text, ByteString)])
-> [(Maybe Text, ByteString)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe Text -> Value -> [(Maybe Text, ByteString)]
jsonToFormDataFlat Maybe Text
name

-- | creates form data bytestring array
createFormData :: (Aeson.ToJSON a) => a -> [(BS.ByteString, BS.ByteString)]
createFormData :: forall a. ToJSON a => a -> [(ByteString, ByteString)]
createFormData a
body =
  let formData :: [(Text, Text)]
formData = Value -> [(Text, Text)]
jsonToFormData (Value -> [(Text, Text)]) -> Value -> [(Text, Text)]
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
body
   in ((Text, Text) -> (ByteString, ByteString))
-> [(Text, Text)] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Text -> ByteString)
-> (Text -> ByteString) -> (Text, Text) -> (ByteString, ByteString)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
BF.bimap Text -> ByteString
textToByte Text -> ByteString
textToByte) [(Text, Text)]
formData

-- | Convert a 'BS.ByteString' to 'Text'
byteToText :: BS.ByteString -> Text
byteToText :: ByteString -> Text
byteToText = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
lenientDecode

-- | Convert 'Text' a to 'BS.ByteString'
textToByte :: Text -> BS.ByteString
textToByte :: Text -> ByteString
textToByte = Text -> ByteString
TE.encodeUtf8

parseURL :: Text -> HS.Request
parseURL :: Text -> Request
parseURL Text
url =
  Request -> Maybe Request -> Request
forall a. a -> Maybe a -> a
Maybe.fromMaybe Request
HS.defaultRequest (Maybe Request -> Request) -> Maybe Request -> Request
forall a b. (a -> b) -> a -> b
$
    String -> Maybe Request
forall (m :: * -> *). MonadThrow m => String -> m Request
HS.parseRequest (String -> Maybe Request) -> String -> Maybe Request
forall a b. (a -> b) -> a -> b
$
      Text -> String
T.unpack Text
url

jsonToFormData :: Aeson.Value -> [(Text, Text)]
jsonToFormData :: Value -> [(Text, Text)]
jsonToFormData = Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed Text
""

jsonToFormDataPrefixed :: Text -> Aeson.Value -> [(Text, Text)]
jsonToFormDataPrefixed :: Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed Text
prefix (Aeson.Number Scientific
a) = case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger Scientific
a :: Maybe Int of
  Just Int
myInt -> [(Text
prefix, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
myInt)]
  Maybe Int
Nothing -> [(Text
prefix, String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> String
forall a. Show a => a -> String
show Scientific
a)]
jsonToFormDataPrefixed Text
prefix (Aeson.Bool Bool
True) = [(Text
prefix, Text
"true")]
jsonToFormDataPrefixed Text
prefix (Aeson.Bool Bool
False) = [(Text
prefix, Text
"false")]
jsonToFormDataPrefixed Text
_ Value
Aeson.Null = []
jsonToFormDataPrefixed Text
prefix (Aeson.String Text
a) = [(Text
prefix, Text
a)]
jsonToFormDataPrefixed Text
"" (Aeson.Object Object
object) =
  Object -> [(Text, Value)]
forall v. KeyMap v -> [(Text, v)]
jsonObjectToList Object
object [(Text, Value)]
-> ((Text, Value) -> [(Text, Text)]) -> [(Text, Text)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Text -> Value -> [(Text, Text)])
-> (Text, Value) -> [(Text, Text)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed
jsonToFormDataPrefixed Text
prefix (Aeson.Object Object
object) =
  Object -> [(Text, Value)]
forall v. KeyMap v -> [(Text, v)]
jsonObjectToList Object
object [(Text, Value)]
-> ((Text, Value) -> [(Text, Text)]) -> [(Text, Text)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\(Text
x, Value
y) -> Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
x Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]") Value
y)
jsonToFormDataPrefixed Text
prefix (Aeson.Array Array
vector) =
  Array -> [Value]
forall a. Vector a -> [a]
Vector.toList Array
vector [Value] -> (Value -> [(Text, Text)]) -> [(Text, Text)]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Value -> [(Text, Text)]
jsonToFormDataPrefixed (Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"[]")

-- | This function makes the code generation for URL parameters easier as it allows to stringify a value
--
-- The 'Show' class is not sufficient as strings should not be stringified with quotes.
stringifyModel :: (Aeson.ToJSON a) => a -> Text
stringifyModel :: forall a. ToJSON a => a -> Text
stringifyModel a
x = case a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x of
  Aeson.String Text
s -> Text
s
  Value
v -> Text -> Text
toStrict (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Builder -> Text
toLazyText (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ Value -> Builder
forall a. ToJSON a => a -> Builder
encodeToTextBuilder Value
v

-- | Wraps a 'BS.ByteString' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON'
newtype JsonByteString = JsonByteString BS.ByteString
  deriving (Int -> JsonByteString -> ShowS
[JsonByteString] -> ShowS
JsonByteString -> String
(Int -> JsonByteString -> ShowS)
-> (JsonByteString -> String)
-> ([JsonByteString] -> ShowS)
-> Show JsonByteString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonByteString -> ShowS
showsPrec :: Int -> JsonByteString -> ShowS
$cshow :: JsonByteString -> String
show :: JsonByteString -> String
$cshowList :: [JsonByteString] -> ShowS
showList :: [JsonByteString] -> ShowS
Show, JsonByteString -> JsonByteString -> Bool
(JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool) -> Eq JsonByteString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: JsonByteString -> JsonByteString -> Bool
== :: JsonByteString -> JsonByteString -> Bool
$c/= :: JsonByteString -> JsonByteString -> Bool
/= :: JsonByteString -> JsonByteString -> Bool
Eq, Eq JsonByteString
Eq JsonByteString =>
(JsonByteString -> JsonByteString -> Ordering)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> Bool)
-> (JsonByteString -> JsonByteString -> JsonByteString)
-> (JsonByteString -> JsonByteString -> JsonByteString)
-> Ord JsonByteString
JsonByteString -> JsonByteString -> Bool
JsonByteString -> JsonByteString -> Ordering
JsonByteString -> JsonByteString -> JsonByteString
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: JsonByteString -> JsonByteString -> Ordering
compare :: JsonByteString -> JsonByteString -> Ordering
$c< :: JsonByteString -> JsonByteString -> Bool
< :: JsonByteString -> JsonByteString -> Bool
$c<= :: JsonByteString -> JsonByteString -> Bool
<= :: JsonByteString -> JsonByteString -> Bool
$c> :: JsonByteString -> JsonByteString -> Bool
> :: JsonByteString -> JsonByteString -> Bool
$c>= :: JsonByteString -> JsonByteString -> Bool
>= :: JsonByteString -> JsonByteString -> Bool
$cmax :: JsonByteString -> JsonByteString -> JsonByteString
max :: JsonByteString -> JsonByteString -> JsonByteString
$cmin :: JsonByteString -> JsonByteString -> JsonByteString
min :: JsonByteString -> JsonByteString -> JsonByteString
Ord)

instance Aeson.ToJSON JsonByteString where
  toJSON :: JsonByteString -> Value
toJSON (JsonByteString ByteString
s) = Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
byteToText ByteString
s

instance Aeson.FromJSON JsonByteString where
  parseJSON :: Value -> Parser JsonByteString
parseJSON (Aeson.String Text
s) = JsonByteString -> Parser JsonByteString
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JsonByteString -> Parser JsonByteString)
-> JsonByteString -> Parser JsonByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> JsonByteString
JsonByteString (ByteString -> JsonByteString) -> ByteString -> JsonByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
textToByte Text
s
  parseJSON Value
_ = String -> Parser JsonByteString
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Value cannot be converted to a 'JsonByteString'"

-- | Wraps a 'Time.ZonedTime' to implement 'Aeson.ToJSON' and 'Aeson.FromJSON'
newtype JsonDateTime = JsonDateTime Time.ZonedTime
  deriving (Int -> JsonDateTime -> ShowS
[JsonDateTime] -> ShowS
JsonDateTime -> String
(Int -> JsonDateTime -> ShowS)
-> (JsonDateTime -> String)
-> ([JsonDateTime] -> ShowS)
-> Show JsonDateTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> JsonDateTime -> ShowS
showsPrec :: Int -> JsonDateTime -> ShowS
$cshow :: JsonDateTime -> String
show :: JsonDateTime -> String
$cshowList :: [JsonDateTime] -> ShowS
showList :: [JsonDateTime] -> ShowS
Show)

instance Eq JsonDateTime where
  (JsonDateTime ZonedTime
d1) == :: JsonDateTime -> JsonDateTime -> Bool
== (JsonDateTime ZonedTime
d2) = ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d1 UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
== ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d2

instance Ord JsonDateTime where
  (JsonDateTime ZonedTime
d1) <= :: JsonDateTime -> JsonDateTime -> Bool
<= (JsonDateTime ZonedTime
d2) = ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d1 UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
<= ZonedTime -> UTCTime
Time.zonedTimeToUTC ZonedTime
d2

instance Aeson.ToJSON JsonDateTime where
  toJSON :: JsonDateTime -> Value
toJSON (JsonDateTime ZonedTime
d) = ZonedTime -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON ZonedTime
d

instance Aeson.FromJSON JsonDateTime where
  parseJSON :: Value -> Parser JsonDateTime
parseJSON Value
o = ZonedTime -> JsonDateTime
JsonDateTime (ZonedTime -> JsonDateTime)
-> Parser ZonedTime -> Parser JsonDateTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ZonedTime
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
o

data Nullable a = NonNull a | Null
  deriving (Int -> Nullable a -> ShowS
[Nullable a] -> ShowS
Nullable a -> String
(Int -> Nullable a -> ShowS)
-> (Nullable a -> String)
-> ([Nullable a] -> ShowS)
-> Show (Nullable a)
forall a. Show a => Int -> Nullable a -> ShowS
forall a. Show a => [Nullable a] -> ShowS
forall a. Show a => Nullable a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Nullable a -> ShowS
showsPrec :: Int -> Nullable a -> ShowS
$cshow :: forall a. Show a => Nullable a -> String
show :: Nullable a -> String
$cshowList :: forall a. Show a => [Nullable a] -> ShowS
showList :: [Nullable a] -> ShowS
Show, Nullable a -> Nullable a -> Bool
(Nullable a -> Nullable a -> Bool)
-> (Nullable a -> Nullable a -> Bool) -> Eq (Nullable a)
forall a. Eq a => Nullable a -> Nullable a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Nullable a -> Nullable a -> Bool
== :: Nullable a -> Nullable a -> Bool
$c/= :: forall a. Eq a => Nullable a -> Nullable a -> Bool
/= :: Nullable a -> Nullable a -> Bool
Eq)

instance (Aeson.ToJSON a) => Aeson.ToJSON (Nullable a) where
  toJSON :: Nullable a -> Value
toJSON Nullable a
Null = Value
Aeson.Null
  toJSON (NonNull a
x) = a -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON a
x

  toEncoding :: Nullable a -> Encoding
toEncoding Nullable a
Null = Encoding
Encoding.null_
  toEncoding (NonNull a
x) = a -> Encoding
forall a. ToJSON a => a -> Encoding
Aeson.toEncoding a
x

instance (Aeson.FromJSON a) => Aeson.FromJSON (Nullable a) where
  parseJSON :: Value -> Parser (Nullable a)
parseJSON Value
Aeson.Null = Nullable a -> Parser (Nullable a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Nullable a
forall a. Nullable a
Null
  parseJSON Value
x = a -> Nullable a
forall a. a -> Nullable a
NonNull (a -> Nullable a) -> Parser a -> Parser (Nullable a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
Aeson.parseJSON Value
x

#if MIN_VERSION_aeson(2,0,0)
jsonObjectToList :: KeyMap.KeyMap v -> [(Text, v)]
jsonObjectToList :: forall v. KeyMap v -> [(Text, v)]
jsonObjectToList = ((Key, v) -> (Text, v)) -> [(Key, v)] -> [(Text, v)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key -> Text) -> (Key, v) -> (Text, v)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
BF.first Key -> Text
Key.toText) ([(Key, v)] -> [(Text, v)])
-> (KeyMap v -> [(Key, v)]) -> KeyMap v -> [(Text, v)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList
#else
jsonObjectToList :: HMap.HashMap Text v -> [(Text, v)]
jsonObjectToList = HMap.toList
#endif