scarf-sh/tie
1
1
Fork 0
mirror of https://github.com/scarf-sh/tie.git synced 2024-11-22 18:42:05 +03:00
Code Issues Packages Projects Releases Wiki Activity

Support x-tie-haskell-name to override field names

Browse Source
This commit is contained in:
Alex Biehl 2023-04-07 10:37:04 +02:00
parent 4e9764fc58
commit c77f3392a8
26 changed files with 385 additions and 319 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Request.template.hs
View File

@ -52,7 +52,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -73,27 +73,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -144,7 +144,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -186,7 +186,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -205,7 +205,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -229,7 +229,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -246,7 +246,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -267,11 +267,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -294,7 +294,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -308,7 +308,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.

2
Response.template.hs
View File

@ -15,7 +15,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

14
bin/Main.hs
View File

@ -3,6 +3,7 @@
module Main (main) where module Main (main) where
import Data.Version (showVersion)
import Options.Applicative import Options.Applicative
( Parser, ( Parser,
auto, auto,
@ -26,11 +27,10 @@ import Options.Applicative
switch, switch,
value, value,
) )
import Paths_tie (version)
import System.Environment (getArgs) import System.Environment (getArgs)
import Tie (fileWriter, generate) import Tie (fileWriter, generate)
import Prelude hiding (Option) import Prelude hiding (Option)
import Data.Version (showVersion)
import Paths_tie (version)
data Input = Input data Input = Input
{ outputDirectory :: FilePath, { outputDirectory :: FilePath,
@ -82,10 +82,12 @@ options =
) )
versioner :: Parser (a -> a) versioner :: Parser (a -> a)
versioner = infoOption ("tie " <> showVersion version) versioner =
( long "version" infoOption
<> help "Print Tie version" ("tie " <> showVersion version)
) ( long "version"
<> help "Print Tie version"
)
main :: IO () main :: IO ()
main = do main = do

10
src/Tie.hs
View File

@ -77,13 +77,13 @@ import Tie.Writer (Writer, fileWriter, withTestWriter)
import Prelude hiding (Type) import Prelude hiding (Type)
-- | Our own version of nubOrd that both nubs and sorts -- | Our own version of nubOrd that both nubs and sorts
nubOrd :: Ord a => [a] -> [a] nubOrd :: (Ord a) => [a] -> [a]
nubOrd = Set.toList . Set.fromList nubOrd = Set.toList . Set.fromList
-- | Read an OpenAPI spec. Throws in case it can not -- | Read an OpenAPI spec. Throws in case it can not
-- be read or deserialized. -- be read or deserialized.
readOpenApiSpec :: readOpenApiSpec ::
MonadIO m => (MonadIO m) =>
FilePath -> FilePath ->
m OpenApi.OpenApi m OpenApi.OpenApi
readOpenApiSpec filePath = readOpenApiSpec filePath =
@ -104,7 +104,7 @@ specComponents =
-- | Normalizes a 'Type' by extracting the contained inline type -- | Normalizes a 'Type' by extracting the contained inline type
-- definitions. -- definitions.
normalize :: Monad m => Name -> Type -> m (Type, [(Name, Type)]) normalize :: (Monad m) => Name -> Type -> m (Type, [(Name, Type)])
normalize = normalize =
normalizeType normalizeType
( \enclosingType fieldName -> ( \enclosingType fieldName ->
@ -125,7 +125,7 @@ normalize =
-- unnamed types left: -- unnamed types left:
-- forall x. normalize x == [] -- forall x. normalize x == []
-- where x is an element of the result of normalizedTypes -- where x is an element of the result of normalizedTypes
normalizeTypes :: Monad m => [(Name, Type)] -> m [(Name, Type)] normalizeTypes :: (Monad m) => [(Name, Type)] -> m [(Name, Type)]
normalizeTypes types = normalizeTypes types =
concat concat
<$> traverse <$> traverse
@ -137,7 +137,7 @@ normalizeTypes types =
types types
generate :: generate ::
MonadIO m => (MonadIO m) =>
Writer m -> Writer m ->
-- | Package name -- | Package name
Text -> Text ->

20
src/Tie/Codegen/Operation.hs
View File

@ -32,7 +32,7 @@ import Tie.Operation
import Tie.Resolve (Resolver) import Tie.Resolve (Resolver)
import Tie.Type (isArrayType, namedType) import Tie.Type (isArrayType, namedType)
codegenOperations :: Monad m => Resolver m -> [Operation] -> m (PP.Doc ann) codegenOperations :: (Monad m) => Resolver m -> [Operation] -> m (PP.Doc ann)
codegenOperations resolver operations = do codegenOperations resolver operations = do
let groupedOperations :: Map.Map Path [Operation] let groupedOperations :: Map.Map Path [Operation]
groupedOperations = groupedOperations =
@ -121,7 +121,7 @@ codegenOperations resolver operations = do
pure (dataApiDecl <> PP.line <> PP.line <> apiDecl <> PP.line <> inlineablePragma) pure (dataApiDecl <> PP.line <> PP.line <> apiDecl <> PP.line <> inlineablePragma)
codegenApiType :: Monad m => Resolver m -> [Operation] -> m (PP.Doc ann) codegenApiType :: (Monad m) => Resolver m -> [Operation] -> m (PP.Doc ann)
codegenApiType resolver operations = do codegenApiType resolver operations = do
operationsFieldsCode <- traverse (codegenApiTypeOperation resolver) operations operationsFieldsCode <- traverse (codegenApiTypeOperation resolver) operations
let fieldsCode = let fieldsCode =
@ -140,7 +140,7 @@ codegenApiType resolver operations = do
<> "}" <> "}"
pure dataDecl pure dataDecl
codegenApiTypeOperation :: Monad m => Resolver m -> Operation -> m (PP.Doc ann) codegenApiTypeOperation :: (Monad m) => Resolver m -> Operation -> m (PP.Doc ann)
codegenApiTypeOperation resolver Operation {..} = do codegenApiTypeOperation resolver Operation {..} = do
paramsCode <- paramsCode <-
sequence $ sequence $
@ -164,7 +164,7 @@ codegenApiTypeOperation resolver Operation {..} = do
(\x y -> x <+> "->" <> PP.line <> y) (\x y -> x <+> "->" <> PP.line <> y)
( paramsCode ( paramsCode
++ [ codegenRequestBodyComment body <> codegenRequestBodyType body ++ [ codegenRequestBodyComment body <> codegenRequestBodyType body
| Just body<- [requestBody] | Just body <- [requestBody]
] ]
++ ["m" <+> toApiResponseTypeName name] ++ ["m" <+> toApiResponseTypeName name]
) )
@ -194,7 +194,7 @@ codegenApiTypeOperation resolver Operation {..} = do
code <- codegenParamSchema param code <- codegenParamSchema param
pure (codegenParamComment param <> code) pure (codegenParamComment param <> code)
codegenOperation :: Monad m => Resolver m -> [Operation] -> m (PP.Doc ann) codegenOperation :: (Monad m) => Resolver m -> [Operation] -> m (PP.Doc ann)
codegenOperation resolver operations@(Operation {path} : _) = codegenOperation resolver operations@(Operation {path} : _) =
pure $ pure $
codegenPathGuard path $ codegenPathGuard path $
@ -297,8 +297,14 @@ codegenRequestBodyGuard requestBody continuation = case requestBody of
Nothing -> Nothing ->
continuation continuation
Just RequestBody {provideRequestBodyAsStream = True} -> Just RequestBody {provideRequestBodyAsStream = True} ->
"let" <+> "body" <+> "=" <+> "Network.Wai.getRequestBodyChunk" <+> "request" <+> "in" <> PP.line <> "let"
PP.indent 4 ("(" <> continuation <> ")") <+> "body"
<+> "="
<+> "Network.Wai.getRequestBodyChunk"
<+> "request"
<+> "in"
<> PP.line
<> PP.indent 4 ("(" <> continuation <> ")")
Just RequestBody {jsonRequestBodyContent} -> Just RequestBody {jsonRequestBodyContent} ->
let parsers = let parsers =
-- TODO support forms -- TODO support forms

2
src/Tie/Codegen/Response.hs
View File

@ -45,7 +45,7 @@ import Tie.Resolve (Resolver)
-- | Generate code for the responses of an 'Operation'. -- | Generate code for the responses of an 'Operation'.
codegenResponses :: codegenResponses ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
-- | Aux. Response module name TODO make this a proper type -- | Aux. Response module name TODO make this a proper type
Text -> Text ->

38
src/Tie/Codegen/Schema.hs
View File

@ -52,7 +52,7 @@ import Tie.Type
import Prelude hiding (Type) import Prelude hiding (Type)
-- | Generate code for a parameter type. -- | Generate code for a parameter type.
codegenParamSchema :: Monad m => Param -> m (Doc ann) codegenParamSchema :: (Monad m) => Param -> m (Doc ann)
codegenParamSchema Param {schema, required} = codegenParamSchema Param {schema, required} =
fmap (codegenRequiredOptionalFieldType required) $ fmap (codegenRequiredOptionalFieldType required) $
case schema of case schema of
@ -93,7 +93,7 @@ codegenHeaderSchema Header {schema, required} =
error "Header without schema" error "Header without schema"
-- | Generate code for a schema. -- | Generate code for a schema.
codegenSchema :: Monad m => Name -> Type -> m (Doc ann) codegenSchema :: (Monad m) => Name -> Type -> m (Doc ann)
codegenSchema typName typ codegenSchema typName typ
| Just Enumeration {alternatives, includeNull} <- isEnumType typ = | Just Enumeration {alternatives, includeNull} <- isEnumType typ =
pure (codegenEnumeration typName alternatives includeNull) pure (codegenEnumeration typName alternatives includeNull)
@ -126,7 +126,7 @@ codegenArrayType typeName elemType =
"type" <+> toDataTypeName typeName <+> "=" <+> "[" <+> codegenFieldType elemType <+> "]" "type" <+> toDataTypeName typeName <+> "=" <+> "[" <+> codegenFieldType elemType <+> "]"
codegenOneOfType :: codegenOneOfType ::
Monad m => (Monad m) =>
-- | Given a variant type name, returns the discrimintor property -- | Given a variant type name, returns the discrimintor property
-- and value, if any -- and value, if any
(Name -> Maybe (Text, Text)) -> (Name -> Maybe (Text, Text)) ->
@ -263,7 +263,7 @@ codegenOneOfType getDiscriminator typName variants = do
pure (PP.vsep $ intersperse mempty [decl, toJson, fromJson]) pure (PP.vsep $ intersperse mempty [decl, toJson, fromJson])
codegenObjectType :: Monad m => Name -> ObjectType (Named Type) -> m (Doc ann) codegenObjectType :: (Monad m) => Name -> ObjectType (Named Type) -> m (Doc ann)
codegenObjectType typName ObjectType {..} codegenObjectType typName ObjectType {..}
-- for empty, free form objects, just generate a type synonym for Value. -- for empty, free form objects, just generate a type synonym for Value.
| Just FreeForm <- additionalProperties, | Just FreeForm <- additionalProperties,
@ -366,12 +366,14 @@ codegenObjectType typName ObjectType {..}
4 4
( PP.concatWith ( PP.concatWith
(\x y -> x <> "," <> PP.line <> y) (\x y -> x <> "," <> PP.line <> y)
[ toFieldName field [ toFieldName haskellField
<+> "::" <+> "::"
<+> codegenRequiredOptionalFieldType <+> codegenRequiredOptionalFieldType
(HashSet.member field requiredProperties) (HashSet.member field requiredProperties)
(codegenFieldType fieldType) (codegenFieldType fieldType)
| (field, fieldType) <- orderedProperties | (field, fieldType) <- orderedProperties,
let haskellField =
HashMap.lookupDefault field field haskellFieldNames
] ]
) )
<> PP.line <> PP.line
@ -403,9 +405,11 @@ codegenObjectType typName ObjectType {..}
<+> PP.align <+> PP.align
( PP.concatWith ( PP.concatWith
(\x y -> x <> "," <> PP.line <> y) (\x y -> x <> "," <> PP.line <> y)
[ "\"" <> toJsonFieldName field <> "\"" <+> "Data.Aeson..=" <+> toFieldName field [ "\"" <> toJsonFieldName field <> "\"" <+> "Data.Aeson..=" <+> toFieldName haskellField
| (field, _) <- orderedProperties, | (field, _) <- orderedProperties,
HashSet.member field requiredProperties HashSet.member field requiredProperties,
let haskellField =
HashMap.lookupDefault field field haskellFieldNames
] ]
) )
<> PP.line <> PP.line
@ -417,16 +421,18 @@ codegenObjectType typName ObjectType {..}
<+> "[" <+> "["
<+> "\"" <> toJsonFieldName field <> "\"" <+> "\"" <> toJsonFieldName field <> "\""
<+> "Data.Aeson..=" <+> "Data.Aeson..="
<+> toFieldName field <+> toFieldName haskellField
<+> "|" <+> "|"
<+> "Just" <+> "Just"
<+> toFieldName field <+> toFieldName haskellField
<+> "<-" <+> "<-"
<+> "[" <> toFieldName field <> "]" <+> "[" <> toFieldName haskellField <> "]"
<+> "]" <+> "]"
) )
| (field, _) <- orderedProperties, | (field, _) <- orderedProperties,
not (HashSet.member field requiredProperties) not (HashSet.member field requiredProperties),
let haskellField =
HashMap.lookupDefault field field haskellFieldNames
] ]
<> ")" <> ")"
) )
@ -449,7 +455,7 @@ codegenObjectType typName ObjectType {..}
"Data.Aeson.Encoding.pair" "Data.Aeson.Encoding.pair"
<+> "\"" <> toJsonFieldName field <> "\"" <+> "\"" <> toJsonFieldName field <> "\""
<+> "(" <> "Data.Aeson.toEncoding" <+> "(" <> "Data.Aeson.toEncoding"
<+> toFieldName field <> ")" <+> toFieldName haskellField <> ")"
else else
"maybe" "maybe"
<+> "mempty" <+> "mempty"
@ -458,8 +464,10 @@ codegenObjectType typName ObjectType {..}
<+> "\"" <> toJsonFieldName field <> "\"" <+> "\"" <> toJsonFieldName field <> "\""
<+> "." <+> "."
<+> "Data.Aeson.toEncoding" <> ")" <+> "Data.Aeson.toEncoding" <> ")"
<+> toFieldName field <+> toFieldName haskellField
| (field, _) <- orderedProperties | (field, _) <- orderedProperties,
let haskellField =
HashMap.lookupDefault field field haskellFieldNames
] ]
) )
<> PP.line <> PP.line

53
src/Tie/Operation.hs
View File

@ -39,10 +39,10 @@ module Tie.Operation
) )
where where
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import Control.Monad.Writer (WriterT (..), runWriterT) import Control.Monad.Writer (WriterT (..), runWriterT)
import Control.Monad.Writer.Strict (tell) import Control.Monad.Writer.Strict (tell)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Types as Aeson
import qualified Data.HashMap.Strict.InsOrd as InsOrd import qualified Data.HashMap.Strict.InsOrd as InsOrd
import qualified Data.OpenApi as OpenApi import qualified Data.OpenApi as OpenApi
import qualified Data.Text as Text import qualified Data.Text as Text
@ -150,7 +150,7 @@ data Operation = Operation
data Errors m = Errors data Errors m = Errors
{ missingOperationId :: forall a. m a, { missingOperationId :: forall a. m a,
unsupportedMediaType :: forall a. HasCallStack => m a, unsupportedMediaType :: forall a. (HasCallStack) => m a,
requestBodyMissingSchema :: forall a. m a, requestBodyMissingSchema :: forall a. m a,
unknownParameter :: forall a. Text -> m a, unknownParameter :: forall a. Text -> m a,
paramMissingSchema :: forall a. m a, paramMissingSchema :: forall a. m a,
@ -210,7 +210,7 @@ operationResponseDependencies :: Operation -> [Name]
operationResponseDependencies Operation {name} = [name] operationResponseDependencies Operation {name} = [name]
pathItemsToOperation :: pathItemsToOperation ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
-- | Conversion error cases -- | Conversion error cases
Errors m -> Errors m ->
@ -240,7 +240,7 @@ pathItemsToOperation resolver errors@Errors {..} pathInfos = do
-- TODO name -- TODO name
operationToOperation :: operationToOperation ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
-- | Conversion error cases -- | Conversion error cases
Errors m -> Errors m ->
@ -304,7 +304,7 @@ operationToOperation resolver errors@Errors {..} method path params OpenApi.Oper
} }
requestBodyToRequestBody :: requestBodyToRequestBody ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
Errors m -> Errors m ->
OpenApi.RequestBody -> OpenApi.RequestBody ->
@ -314,20 +314,21 @@ requestBodyToRequestBody resolver Errors {..} requestBody = do
OpenApi._unDefs (OpenApi._requestBodyExtensions requestBody) OpenApi._unDefs (OpenApi._requestBodyExtensions requestBody)
provideRequestBodyAsStream provideRequestBodyAsStream
| Just extensionValue <- InsOrd.lookup "tie-haskell-request-body-as-stream" extensions | Just extensionValue <- InsOrd.lookup "tie-haskell-request-body-as-stream" extensions,
, Just flag <- Aeson.parseMaybe Aeson.parseJSON extensionValue Just flag <- Aeson.parseMaybe Aeson.parseJSON extensionValue =
= flag flag
| otherwise = | otherwise =
False False
-- TODO support form inputs as well -- TODO support form inputs as well
OpenApi.MediaTypeObject {..} <- whenNothing ( OpenApi.MediaTypeObject {..} <-
asum [ whenNothing
InsOrd.lookup "application/json" (OpenApi._requestBodyContent requestBody), ( asum
InsOrd.lookup "application/x-ndjson" (OpenApi._requestBodyContent requestBody) [ InsOrd.lookup "application/json" (OpenApi._requestBodyContent requestBody),
] InsOrd.lookup "application/x-ndjson" (OpenApi._requestBodyContent requestBody)
) ]
(traceShow requestBody $ unsupportedMediaType) )
(traceShow requestBody $ unsupportedMediaType)
referencedSchema <- referencedSchema <-
whenNothing whenNothing
_mediaTypeObjectSchema _mediaTypeObjectSchema
@ -342,7 +343,7 @@ requestBodyToRequestBody resolver Errors {..} requestBody = do
} }
responseToResponse :: responseToResponse ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
Errors m -> Errors m ->
OpenApi.Response -> OpenApi.Response ->
@ -358,7 +359,7 @@ responseToResponse resolver errors@Errors {..} response@OpenApi.Response {..} =
} }
responseMediaTypeObject :: responseMediaTypeObject ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
Errors m -> Errors m ->
OpenApi.Response -> OpenApi.Response ->
@ -396,7 +397,7 @@ pathDependencies path =
[schema | VariableSegment Param {schema} <- path] [schema | VariableSegment Param {schema} <- path]
paramToParam :: paramToParam ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
Errors m -> Errors m ->
OpenApi.Param -> OpenApi.Param ->
@ -426,7 +427,7 @@ paramToParam resolver Errors {..} OpenApi.Param {..} = do
} }
headerToHeader :: headerToHeader ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
Errors m -> Errors m ->
Text -> Text ->
@ -444,7 +445,7 @@ headerToHeader resolver Errors {..} name referencedHeader = do
} }
pathToPath :: pathToPath ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
Errors m -> Errors m ->
-- | URL Path -- | URL Path
@ -473,7 +474,7 @@ pathToPath resolver errors@Errors {..} textualPath params = do
paramNotBasicType paramNotBasicType
pure param pure param
normalizeParam :: Monad m => Name -> Param -> m (Param, [(Name, Type)]) normalizeParam :: (Monad m) => Name -> Param -> m (Param, [(Name, Type)])
normalizeParam operationName param@Param {..} = do normalizeParam operationName param@Param {..} = do
(normedType, inlineDefinitions) <- (normedType, inlineDefinitions) <-
normalizeNamedType normalizeNamedType
@ -481,7 +482,7 @@ normalizeParam operationName param@Param {..} = do
schema schema
pure (param {schema = normedType} :: Param, inlineDefinitions) pure (param {schema = normedType} :: Param, inlineDefinitions)
normalizeResponse :: Monad m => Name -> Response -> m (Response, [(Name, Type)]) normalizeResponse :: (Monad m) => Name -> Response -> m (Response, [(Name, Type)])
normalizeResponse name response@Response {..} = do normalizeResponse name response@Response {..} = do
(responseContent, inlineDefinitions) <- runWriterT $ (responseContent, inlineDefinitions) <- runWriterT $
forM responseContent $ \(mediaType, schema) -> do forM responseContent $ \(mediaType, schema) -> do
@ -494,7 +495,7 @@ normalizeResponse name response@Response {..} = do
pure (mediaType, Just normedType) pure (mediaType, Just normedType)
pure (response {responseContent}, inlineDefinitions) pure (response {responseContent}, inlineDefinitions)
normalizeRequestBody :: Monad m => Name -> RequestBody -> m (RequestBody, [(Name, Type)]) normalizeRequestBody :: (Monad m) => Name -> RequestBody -> m (RequestBody, [(Name, Type)])
normalizeRequestBody name body@RequestBody {..} = do normalizeRequestBody name body@RequestBody {..} = do
(normedType, inlineDefinitions) <- (normedType, inlineDefinitions) <-
normalizeNamedType normalizeNamedType
@ -502,7 +503,7 @@ normalizeRequestBody name body@RequestBody {..} = do
jsonRequestBodyContent jsonRequestBodyContent
pure (body {jsonRequestBodyContent = normedType}, inlineDefinitions) pure (body {jsonRequestBodyContent = normedType}, inlineDefinitions)
normalizeOperation :: Monad m => Operation -> m (Operation, [(Name, Type)]) normalizeOperation :: (Monad m) => Operation -> m (Operation, [(Name, Type)])
normalizeOperation operation@Operation {..} = normalizeOperation operation@Operation {..} =
fmap (second (sortOn fst)) $ fmap (second (sortOn fst)) $
runWriterT $ do runWriterT $ do

4
src/Tie/Resolve.hs
View File

@ -18,11 +18,11 @@ import qualified Data.Text as Text
-- | Resolve an 'OpenApi.Reference' to the underlying component. -- | Resolve an 'OpenApi.Reference' to the underlying component.
newtype Resolver m = Resolver newtype Resolver m = Resolver
{ resolve :: forall a. Resolvable a => OpenApi.Referenced a -> m a { resolve :: forall a. (Resolvable a) => OpenApi.Referenced a -> m a
} }
newResolver :: newResolver ::
Applicative m => (Applicative m) =>
OpenApi.Components -> OpenApi.Components ->
(forall a. OpenApi.Reference -> m a) -> (forall a. OpenApi.Reference -> m a) ->
Resolver m Resolver m

86
src/Tie/Type.hs
View File

@ -54,6 +54,7 @@ import qualified Data.HashSet as HashSet
import Data.OpenApi (HasDiscriminator (discriminator)) import Data.OpenApi (HasDiscriminator (discriminator))
import qualified Data.OpenApi as OpenApi import qualified Data.OpenApi as OpenApi
import qualified Data.Text as Text import qualified Data.Text as Text
import Relude.Extra.Lens ((^.))
import Tie.Name (Name, extractHaskellModule, fromText) import Tie.Name (Name, extractHaskellModule, fromText)
import Tie.Resolve (Resolver, resolve) import Tie.Resolve (Resolver, resolve)
import Prelude hiding (Type) import Prelude hiding (Type)
@ -117,7 +118,9 @@ data FreeFormObject ty
data ObjectType ty = ObjectType data ObjectType ty = ObjectType
{ properties :: HashMap Name ty, { properties :: HashMap Name ty,
requiredProperties :: HashSet Name, requiredProperties :: HashSet Name,
additionalProperties :: Maybe (FreeFormObject ty) additionalProperties :: Maybe (FreeFormObject ty),
-- | Names of each property in the generated Haskell code
haskellFieldNames :: HashMap Name Name
} }
deriving (Eq, Ord, Show, Functor, Foldable, Traversable) deriving (Eq, Ord, Show, Functor, Foldable, Traversable)
@ -185,20 +188,33 @@ isEnumType typ
Nothing Nothing
schemaRefToType :: schemaRefToType ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
OpenApi.Referenced OpenApi.Schema -> OpenApi.Referenced OpenApi.Schema ->
m (Named Type) m (Named Type)
schemaRefToType resolver referencedSchema = do schemaRefToType resolver referencedSchema =
fmap fst $
schemaRefToType_ resolver referencedSchema
schemaRefToType_ ::
(Monad m) =>
Resolver m ->
OpenApi.Referenced OpenApi.Schema ->
m (Named Type, OpenApi.SpecificationExtensions)
schemaRefToType_ resolver referencedSchema = do
schema <- resolve resolver referencedSchema schema <- resolve resolver referencedSchema
case referencedSchema of case referencedSchema of
OpenApi.Ref reference -> OpenApi.Ref reference -> do
Named (fromText (OpenApi.getReference reference)) type_ <-
<$> schemaToType resolver schema Named (fromText (OpenApi.getReference reference))
<$> schemaToType resolver schema
pure (type_, schema ^. OpenApi.extensions)
OpenApi.Inline schema -> do OpenApi.Inline schema -> do
Unnamed <$> schemaToType resolver schema type_ <-
Unnamed <$> schemaToType resolver schema
pure (type_, schema ^. OpenApi.extensions)
resolveMapping :: Monad m => Resolver m -> Text -> m Text resolveMapping :: (Monad m) => Resolver m -> Text -> m Text
resolveMapping resolver referenceOrschemaName = do resolveMapping resolver referenceOrschemaName = do
let -- The OpenApi package doesn't expose a way to parse references. let -- The OpenApi package doesn't expose a way to parse references.
-- Instead we construct the JSON manually and let it run through -- Instead we construct the JSON manually and let it run through
@ -215,7 +231,7 @@ resolveMapping resolver referenceOrschemaName = do
-- | Converts an 'OpenApi.Schema' to our internal 'Type' representation. -- | Converts an 'OpenApi.Schema' to our internal 'Type' representation.
-- An optional 'ComponentName' indicates the name of component. -- An optional 'ComponentName' indicates the name of component.
schemaToType :: Monad m => Resolver m -> OpenApi.Schema -> m Type schemaToType :: (Monad m) => Resolver m -> OpenApi.Schema -> m Type
schemaToType resolver schema schemaToType resolver schema
| Just allOfsRefs <- OpenApi._schemaAllOf schema = do | Just allOfsRefs <- OpenApi._schemaAllOf schema = do
AllOf <$> traverse (schemaRefToType resolver) allOfsRefs AllOf <$> traverse (schemaRefToType resolver) allOfsRefs
@ -270,7 +286,8 @@ schemaToType resolver schema
( ObjectType ( ObjectType
{ properties = mempty, { properties = mempty,
requiredProperties = mempty, requiredProperties = mempty,
additionalProperties = Just FreeForm additionalProperties = Just FreeForm,
haskellFieldNames = mempty
} }
) )
) )
@ -295,7 +312,8 @@ schemaToType resolver schema
( ObjectType ( ObjectType
{ properties = mempty, { properties = mempty,
requiredProperties = mempty, requiredProperties = mempty,
additionalProperties = Just FreeForm additionalProperties = Just FreeForm,
haskellFieldNames = mempty
} }
) )
) )
@ -303,15 +321,35 @@ schemaToType resolver schema
-- | Resolves an 'OpenApi.Schema' to an 'ObjectType'. In case the the 'OpenApi.Schema' is an -- | Resolves an 'OpenApi.Schema' to an 'ObjectType'. In case the the 'OpenApi.Schema' is an
-- allOf-schema. This function doesn't do any additional type checking. -- allOf-schema. This function doesn't do any additional type checking.
schemaToObjectType :: schemaToObjectType ::
Monad m => (Monad m) =>
Resolver m -> Resolver m ->
OpenApi.Schema -> OpenApi.Schema ->
m (ObjectType (Named Type)) m (ObjectType (Named Type))
schemaToObjectType resolver schema = do schemaToObjectType resolver schema = do
properties <- propertiesWithExtensions <-
traverse traverse
(schemaRefToType resolver) (schemaRefToType_ resolver)
(InsOrd.toHashMap (OpenApi._schemaProperties schema)) (InsOrd.toHashMap (OpenApi._schemaProperties schema))
let properties =
fmap fst propertiesWithExtensions
-- x-tie-haskell-name allows users to specify the property name to use
-- in the generated Haskell code
haskellFieldNames :: HashMap Text Name
haskellFieldNames =
HashMap.mapWithKey
( \property (_type, extensions) ->
case InsOrd.lookup "tie-haskell-name" (OpenApi._unDefs extensions) of
Just extensionValue
| Just haskellFieldName <- Aeson.parseMaybe Aeson.parseJSON extensionValue ->
fromText haskellFieldName
_ ->
-- If there is no name override specified or the override doesn't parse
-- as string, we use the property name itself.
fromText property
)
propertiesWithExtensions
freeFormObject <- case OpenApi._schemaAdditionalProperties schema of freeFormObject <- case OpenApi._schemaAdditionalProperties schema of
Nothing -> Nothing ->
pure Nothing pure Nothing
@ -329,7 +367,9 @@ schemaToObjectType resolver schema = do
properties = properties =
HashMap.fromList (map (first fromText) (HashMap.toList properties)), HashMap.fromList (map (first fromText) (HashMap.toList properties)),
requiredProperties = requiredProperties =
HashSet.fromList (map fromText (OpenApi._schemaRequired schema)) HashSet.fromList (map fromText (OpenApi._schemaRequired schema)),
haskellFieldNames =
HashMap.fromList (map (first fromText) (HashMap.toList haskellFieldNames))
} }
-- | Treat an 'OpenApi.Schema' as stringy. Accounts for enumerations -- | Treat an 'OpenApi.Schema' as stringy. Accounts for enumerations
@ -519,7 +559,8 @@ isObjectType ty = case ty of
ObjectType ObjectType
{ properties = mempty, { properties = mempty,
requiredProperties = mempty, requiredProperties = mempty,
additionalProperties = Nothing additionalProperties = Nothing,
haskellFieldNames = mempty
} }
-- Combine two ObjectTypes. Doesn't report common fields! Also merging -- Combine two ObjectTypes. Doesn't report common fields! Also merging
@ -540,11 +581,12 @@ isObjectType ty = case ty of
(Just x, Just y) -> (Just x, Just y) ->
-- This might be controversial, OTOH definining additional properties on both -- This might be controversial, OTOH definining additional properties on both
-- objects is undefined behavior anyways. -- objects is undefined behavior anyways.
Just FreeForm Just FreeForm,
haskellFieldNames = haskellFieldNames o1 <> haskellFieldNames o2
} }
normalizeNamedType :: normalizeNamedType ::
Monad m => (Monad m) =>
-- | Generate a new name based on the context of an anonymous type. Within 'normalizeNamedType' -- | Generate a new name based on the context of an anonymous type. Within 'normalizeNamedType'
-- we don't know anything about the enclosing context and we expect the callers to do the right -- we don't know anything about the enclosing context and we expect the callers to do the right
-- thing (tm). -- thing (tm).
@ -574,7 +616,7 @@ normalizeNamedType assignName namedType = case namedType of
pure (namedType, []) pure (namedType, [])
normalizeObjectType :: normalizeObjectType ::
Monad m => (Monad m) =>
-- | Assign a name to an anonnymous type in a field of an 'ObjectType' -- | Assign a name to an anonnymous type in a field of an 'ObjectType'
(Name -> m Name) -> (Name -> m Name) ->
-- | Assign a name to the additionalProperties type of an 'ObjectType' -- | Assign a name to the additionalProperties type of an 'ObjectType'
@ -600,7 +642,7 @@ normalizeObjectType assignObjectFieldTypeName assignAdditionaPropertiesTypeName
pure (objectType {additionalProperties, properties}, newTypes <> newTypes') pure (objectType {additionalProperties, properties}, newTypes <> newTypes')
normalizeVariants :: normalizeVariants ::
Monad m => (Monad m) =>
(Int -> m Name) -> (Int -> m Name) ->
[Named Type] -> [Named Type] ->
m ([Named Type], [(Name, Type)]) m ([Named Type], [(Name, Type)])
@ -622,7 +664,7 @@ normalizeVariants assignName variants = runWriterT $
-- - top-level definitions -- - top-level definitions
-- - inline definitions that we just assigned a name -- - inline definitions that we just assigned a name
normalizeTypeShallow :: normalizeTypeShallow ::
Monad m => (Monad m) =>
-- | Assign a name to an anonnymous type in a field of an 'ObjectType' -- | Assign a name to an anonnymous type in a field of an 'ObjectType'
(Name -> Name -> m Name) -> (Name -> Name -> m Name) ->
-- | Assign a name to the additionalProperties type of an 'ObjectType' -- | Assign a name to the additionalProperties type of an 'ObjectType'
@ -667,7 +709,7 @@ normalizeTypeShallow
-- Normalizes a 'Type' by assigning each anonymous, inline definition a name. -- Normalizes a 'Type' by assigning each anonymous, inline definition a name.
-- Returns the normalized 'Type' alongside with the additional inline definitions. -- Returns the normalized 'Type' alongside with the additional inline definitions.
normalizeType :: normalizeType ::
Monad m => (Monad m) =>
-- | Assign a name to an anonnymous type in a field of an 'ObjectType' -- | Assign a name to an anonnymous type in a field of an 'ObjectType'
(Name -> Name -> m Name) -> (Name -> Name -> m Name) ->
-- | Assign a name to the additionalProperties type of an 'ObjectType' -- | Assign a name to the additionalProperties type of an 'ObjectType'

4
src/Tie/Writer.hs
View File

@ -29,7 +29,7 @@ render =
-- | Renders 'Doc's to a file just as you would expect. Writes files relative -- | Renders 'Doc's to a file just as you would expect. Writes files relative
-- to the given output directory. -- to the given output directory.
fileWriter :: MonadIO m => FilePath -> Writer m fileWriter :: (MonadIO m) => FilePath -> Writer m
fileWriter outputDirectory path doc = liftIO $ do fileWriter outputDirectory path doc = liftIO $ do
let fullPath = outputDirectory </> path let fullPath = outputDirectory </> path
createDirectoryIfMissing True (takeDirectory fullPath) createDirectoryIfMissing True (takeDirectory fullPath)
@ -38,7 +38,7 @@ fileWriter outputDirectory path doc = liftIO $ do
-- | Collects all the FilePath and Doc pairs and returns them concatenated -- | Collects all the FilePath and Doc pairs and returns them concatenated
-- in one output -- in one output
withTestWriter :: MonadIO m => (Writer m -> m a) -> m (a, Builder) withTestWriter :: (MonadIO m) => (Writer m -> m a) -> m (a, Builder)
withTestWriter action = do withTestWriter action = do
ref <- liftIO (newIORef []) ref <- liftIO (newIORef [])
result <- action $ \file doc -> result <- action $ \file doc ->

30
test/golden/additional-properties.yaml.out
View File

@ -139,7 +139,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -160,27 +160,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -231,7 +231,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -273,7 +273,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -292,7 +292,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -316,7 +316,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -333,7 +333,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -354,11 +354,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -381,7 +381,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -395,7 +395,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -436,7 +436,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/bug-1.yaml.out
View File

@ -125,7 +125,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -146,27 +146,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -217,7 +217,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -259,7 +259,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -278,7 +278,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -302,7 +302,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -319,7 +319,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -340,11 +340,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -367,7 +367,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -381,7 +381,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -422,7 +422,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/csv.yaml.out
View File

@ -139,7 +139,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -160,27 +160,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -231,7 +231,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -273,7 +273,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -292,7 +292,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -316,7 +316,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -333,7 +333,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -354,11 +354,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -381,7 +381,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -395,7 +395,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -436,7 +436,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/datetime.yaml.out
View File

@ -125,7 +125,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -146,27 +146,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -217,7 +217,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -259,7 +259,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -278,7 +278,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -302,7 +302,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -319,7 +319,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -340,11 +340,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -367,7 +367,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -381,7 +381,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -422,7 +422,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/enum-bug.yaml.out
View File

@ -128,7 +128,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -149,27 +149,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -220,7 +220,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -262,7 +262,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -281,7 +281,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -305,7 +305,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -322,7 +322,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -343,11 +343,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -370,7 +370,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -384,7 +384,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -425,7 +425,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/enum.yaml.out
View File

@ -192,7 +192,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -213,27 +213,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -284,7 +284,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -326,7 +326,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -345,7 +345,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -369,7 +369,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -386,7 +386,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -407,11 +407,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -434,7 +434,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -448,7 +448,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -489,7 +489,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

3
test/golden/haskell-ext.yaml
View File

@ -48,3 +48,6 @@ components:
test1: test1:
type: string type: string
x-tie-haskell-type: Scarf.Hashids.Hashid Int32 x-tie-haskell-type: Scarf.Hashids.Hashid Int32
test2:
type: string
x-tie-haskell-name: abcdef

42
test/golden/haskell-ext.yaml.out
View File

@ -143,7 +143,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -164,27 +164,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -235,7 +235,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -277,7 +277,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -296,7 +296,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -320,7 +320,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -337,7 +337,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -358,11 +358,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -385,7 +385,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -399,7 +399,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -440,7 +440,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream
@ -619,9 +619,10 @@ import qualified Scarf.Hashids
newtype Test = Test data Test = Test
{ {
test1 :: (Data.Maybe.Maybe (Scarf.Hashids.Hashid Int32)) test1 :: (Data.Maybe.Maybe (Scarf.Hashids.Hashid Int32)),
abcdef :: (Data.Maybe.Maybe (Data.Text.Text))
} }
deriving (Show) deriving (Show)
@ -629,16 +630,19 @@ instance Data.Aeson.ToJSON Test where
toJSON Test {..} = Data.Aeson.object toJSON Test {..} = Data.Aeson.object
([ ([
] ]
++ [ "test1" Data.Aeson..= test1 | Just test1 <- [test1] ]) ++ [ "test1" Data.Aeson..= test1 | Just test1 <- [test1] ]
++ [ "test2" Data.Aeson..= abcdef | Just abcdef <- [abcdef] ])
toEncoding Test {..} = Data.Aeson.Encoding.pairs toEncoding Test {..} = Data.Aeson.Encoding.pairs
( maybe mempty (Data.Aeson.Encoding.pair "test1" . Data.Aeson.toEncoding) test1 ( maybe mempty (Data.Aeson.Encoding.pair "test1" . Data.Aeson.toEncoding) test1 <>
maybe mempty (Data.Aeson.Encoding.pair "test2" . Data.Aeson.toEncoding) abcdef
) )
instance Data.Aeson.FromJSON Test where instance Data.Aeson.FromJSON Test where
parseJSON = Data.Aeson.withObject "Test" $ \o -> parseJSON = Data.Aeson.withObject "Test" $ \o ->
Test Test
<$> o Data.Aeson..:? "test1" <$> o Data.Aeson..:? "test1"
<*> o Data.Aeson..:? "test2"
--------------------- ---------------------
test.cabal test.cabal

30
test/golden/headers.yaml.out
View File

@ -156,7 +156,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -177,27 +177,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -248,7 +248,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -290,7 +290,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -309,7 +309,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -333,7 +333,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -350,7 +350,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -371,11 +371,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -398,7 +398,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -412,7 +412,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -453,7 +453,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/lists.yaml.out
View File

@ -189,7 +189,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -210,27 +210,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -281,7 +281,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -323,7 +323,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -342,7 +342,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -366,7 +366,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -383,7 +383,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -404,11 +404,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -431,7 +431,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -445,7 +445,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -486,7 +486,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/numbers.yaml.out
View File

@ -125,7 +125,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -146,27 +146,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -217,7 +217,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -259,7 +259,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -278,7 +278,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -302,7 +302,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -319,7 +319,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -340,11 +340,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -367,7 +367,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -381,7 +381,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -422,7 +422,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/object-without-type.yaml.out
View File

@ -125,7 +125,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -146,27 +146,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -217,7 +217,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -259,7 +259,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -278,7 +278,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -302,7 +302,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -319,7 +319,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -340,11 +340,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -367,7 +367,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -381,7 +381,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -422,7 +422,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/oneof.yaml.out
View File

@ -155,7 +155,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -176,27 +176,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -247,7 +247,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -289,7 +289,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -308,7 +308,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -332,7 +332,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -349,7 +349,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -370,11 +370,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -397,7 +397,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -411,7 +411,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -452,7 +452,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/petstore.yaml.out
View File

@ -156,7 +156,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -177,27 +177,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -248,7 +248,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -290,7 +290,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -309,7 +309,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -333,7 +333,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -350,7 +350,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -371,11 +371,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -398,7 +398,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -412,7 +412,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -453,7 +453,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream

30
test/golden/test1.yaml.out
View File

@ -159,7 +159,7 @@ import Web.HttpApiData
) )
pathVariable :: pathVariable ::
FromHttpApiData a => (FromHttpApiData a) =>
-- | Path variable value -- | Path variable value
Text -> Text ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
@ -180,27 +180,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]} newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input) xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs) pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]} newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input) xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs) pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]} newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input) xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs) pure (PipeDelimitedValue xs)
requiredQueryParameters :: requiredQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) -> (NonEmpty.NonEmpty a -> Wai.Application) ->
@ -251,7 +251,7 @@ requiredQueryParameters style name withParam =
) )
optionalQueryParameters :: optionalQueryParameters ::
FromHttpApiData a => (FromHttpApiData a) =>
Style -> Style ->
ByteString -> ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) -> (Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -293,7 +293,7 @@ optionalQueryParameters style name withParam =
) )
requiredQueryParameter :: requiredQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -312,7 +312,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-} {-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter :: optionalQueryParameter ::
FromHttpApiData a => (FromHttpApiData a) =>
ByteString -> ByteString ->
-- | Allow empty, e.g. "x=" -- | Allow empty, e.g. "x="
Bool -> Bool ->
@ -336,7 +336,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-} {-# INLINEABLE optionalQueryParameter #-}
optionalHeader :: optionalHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(Maybe a -> Wai.Application) -> (Maybe a -> Wai.Application) ->
Wai.Application Wai.Application
@ -353,7 +353,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-} {-# INLINEABLE optionalHeader #-}
requiredHeader :: requiredHeader ::
FromHttpApiData a => (FromHttpApiData a) =>
HeaderName -> HeaderName ->
(a -> Wai.Application) -> (a -> Wai.Application) ->
Wai.Application Wai.Application
@ -374,11 +374,11 @@ data BodyParser a
Network.HTTP.Media.MediaType Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application) ((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-} {-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-} {-# INLINE formBodyParser #-}
@ -401,7 +401,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty) respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-} {-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of case eitherResult result of
@ -415,7 +415,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-} {-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us -- Reads the body using lazy IO. Not great but it gets us
-- going and is pretty local. -- going and is pretty local.
@ -456,7 +456,7 @@ import qualified Network.Wai
type NDJSON element = ((element -> IO ()) -> IO () -> IO ()) type NDJSON element = ((element -> IO ()) -> IO () -> IO ())
responseNDJSON :: Data.Aeson.ToJSON element => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response responseNDJSON :: (Data.Aeson.ToJSON element) => Network.HTTP.Types.Status -> Network.HTTP.Types.ResponseHeaders -> NDJSON element -> Network.Wai.Response
responseNDJSON status responseHeaders stream = responseNDJSON status responseHeaders stream =
Network.Wai.responseStream status responseHeaders $ \emit flush -> Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream stream