scarf-sh/tie
1
1
Fork 0
mirror of https://github.com/scarf-sh/tie.git synced 2024-11-22 10:31:56 +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 committed by Alexander Biehl
parent 4e9764fc58
commit e877363252
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 ::
FromHttpApiData a =>
(FromHttpApiData a) =>
-- | Path variable value
Text ->
(a -> Wai.Application) ->
@ -73,27 +73,27 @@ data Style
newtype CommaDelimitedValue a = CommaDelimitedValue {unCommaDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (CommaDelimitedValue a) where
instance (FromHttpApiData a) => FromHttpApiData (CommaDelimitedValue a) where
parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "," input)
pure (CommaDelimitedValue xs)
newtype SpaceDelimitedValue a = SpaceDelimitedValue {unSpaceDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (SpaceDelimitedValue a) where
instance (FromHttpApiData a) => FromHttpApiData (SpaceDelimitedValue a) where
parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn " " input)
pure (SpaceDelimitedValue xs)
newtype PipeDelimitedValue a = PipeDelimitedValue {unPipeDelimitedValue :: [a]}
instance FromHttpApiData a => FromHttpApiData (PipeDelimitedValue a) where
instance (FromHttpApiData a) => FromHttpApiData (PipeDelimitedValue a) where
parseUrlPiece input = do
xs <- parseUrlPieces (Text.splitOn "|" input)
pure (PipeDelimitedValue xs)
requiredQueryParameters ::
FromHttpApiData a =>
(FromHttpApiData a) =>
Style ->
ByteString ->
(NonEmpty.NonEmpty a -> Wai.Application) ->
@ -144,7 +144,7 @@ requiredQueryParameters style name withParam =
)
optionalQueryParameters ::
FromHttpApiData a =>
(FromHttpApiData a) =>
Style ->
ByteString ->
(Maybe (NonEmpty.NonEmpty a) -> Wai.Application) ->
@ -186,7 +186,7 @@ optionalQueryParameters style name withParam =
)
requiredQueryParameter ::
FromHttpApiData a =>
(FromHttpApiData a) =>
ByteString ->
(a -> Wai.Application) ->
Wai.Application
@ -205,7 +205,7 @@ requiredQueryParameter name withParam = \request respond ->
{-# INLINEABLE requiredQueryParameter #-}
optionalQueryParameter ::
FromHttpApiData a =>
(FromHttpApiData a) =>
ByteString ->
-- | Allow empty, e.g. "x="
Bool ->
@ -229,7 +229,7 @@ optionalQueryParameter name allowEmpty withParam = \request respond ->
{-# INLINEABLE optionalQueryParameter #-}
optionalHeader ::
FromHttpApiData a =>
(FromHttpApiData a) =>
HeaderName ->
(Maybe a -> Wai.Application) ->
Wai.Application
@ -246,7 +246,7 @@ optionalHeader name withHeader = \request respond ->
{-# INLINEABLE optionalHeader #-}
requiredHeader ::
FromHttpApiData a =>
(FromHttpApiData a) =>
HeaderName ->
(a -> Wai.Application) ->
Wai.Application
@ -267,11 +267,11 @@ data BodyParser a
Network.HTTP.Media.MediaType
((a -> Wai.Application) -> Wai.Application)
jsonBodyParser :: FromJSON a => BodyParser a
jsonBodyParser :: (FromJSON a) => BodyParser a
jsonBodyParser = BodyParser "application/json" parseRequestBodyJSON
{-# INLINE jsonBodyParser #-}
formBodyParser :: FromForm a => BodyParser a
formBodyParser :: (FromForm a) => BodyParser a
formBodyParser = BodyParser "application/xxx-form-urlencoded" parseRequestBodyForm
{-# INLINE formBodyParser #-}
@ -294,7 +294,7 @@ parseRequestBody parsers withBody = \request respond -> do
respond (Wai.responseBuilder (toEnum 415) [] mempty)
{-# INLINE parseRequestBody #-}
parseRequestBodyJSON :: FromJSON a => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON :: (FromJSON a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyJSON withBody = \request respond -> do
result <- parseWith (Wai.getRequestBodyChunk request) Data.Aeson.Parser.json' mempty
case eitherResult result of
@ -308,7 +308,7 @@ parseRequestBodyJSON withBody = \request respond -> do
withBody body request respond
{-# INLINEABLE parseRequestBodyJSON #-}
parseRequestBodyForm :: FromForm a => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm :: (FromForm a) => (a -> Wai.Application) -> Wai.Application
parseRequestBodyForm withBody = \request respond -> do
-- Reads the body using lazy IO. Not great but it gets us
-- 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 ())
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 =
Network.Wai.responseStream status responseHeaders $ \emit flush ->
stream

8
bin/Main.hs
View File

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

10
src/Tie.hs
View File

@ -77,13 +77,13 @@ import Tie.Writer (Writer, fileWriter, withTestWriter)
import Prelude hiding (Type)
-- | 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
-- | Read an OpenAPI spec. Throws in case it can not
-- be read or deserialized.
readOpenApiSpec ::
MonadIO m =>
(MonadIO m) =>
FilePath ->
m OpenApi.OpenApi
readOpenApiSpec filePath =
@ -104,7 +104,7 @@ specComponents =
-- | Normalizes a 'Type' by extracting the contained inline type
-- definitions.
normalize :: Monad m => Name -> Type -> m (Type, [(Name, Type)])
normalize :: (Monad m) => Name -> Type -> m (Type, [(Name, Type)])
normalize =
normalizeType
( \enclosingType fieldName ->
@ -125,7 +125,7 @@ normalize =
-- unnamed types left:
-- forall x. normalize x == []
-- 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 =
concat
<$> traverse
@ -137,7 +137,7 @@ normalizeTypes types =
types
generate ::
MonadIO m =>
(MonadIO m) =>
Writer m ->
-- | Package name
Text ->

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

@ -32,7 +32,7 @@ import Tie.Operation
import Tie.Resolve (Resolver)
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
let groupedOperations :: Map.Map Path [Operation]
groupedOperations =
@ -121,7 +121,7 @@ codegenOperations resolver operations = do
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
operationsFieldsCode <- traverse (codegenApiTypeOperation resolver) operations
let fieldsCode =
@ -140,7 +140,7 @@ codegenApiType resolver operations = do
<> "}"
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
paramsCode <-
sequence $
@ -194,7 +194,7 @@ codegenApiTypeOperation resolver Operation {..} = do
code <- codegenParamSchema param
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} : _) =
pure $
codegenPathGuard path $
@ -297,8 +297,14 @@ codegenRequestBodyGuard requestBody continuation = case requestBody of
Nothing ->
continuation
Just RequestBody {provideRequestBodyAsStream = True} ->
"let" <+> "body" <+> "=" <+> "Network.Wai.getRequestBodyChunk" <+> "request" <+> "in" <> PP.line <>
PP.indent 4 ("(" <> continuation <> ")")
"let"
<+> "body"
<+> "="
<+> "Network.Wai.getRequestBodyChunk"
<+> "request"
<+> "in"
<> PP.line
<> PP.indent 4 ("(" <> continuation <> ")")
Just RequestBody {jsonRequestBodyContent} ->
let parsers =
-- 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'.
codegenResponses ::
Monad m =>
(Monad m) =>
Resolver m ->
-- | Aux. Response module name TODO make this a proper type
Text ->

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

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

43
src/Tie/Operation.hs
View File

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

80
src/Tie/Type.hs
View File

@ -54,6 +54,7 @@ import qualified Data.HashSet as HashSet
import Data.OpenApi (HasDiscriminator (discriminator))
import qualified Data.OpenApi as OpenApi
import qualified Data.Text as Text
import Relude.Extra.Lens ((^.))
import Tie.Name (Name, extractHaskellModule, fromText)
import Tie.Resolve (Resolver, resolve)
import Prelude hiding (Type)
@ -117,7 +118,9 @@ data FreeFormObject ty
data ObjectType ty = ObjectType
{ properties :: HashMap Name ty,
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)
@ -185,20 +188,33 @@ isEnumType typ
Nothing
schemaRefToType ::
Monad m =>
(Monad m) =>
Resolver m ->
OpenApi.Referenced OpenApi.Schema ->
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
case referencedSchema of
OpenApi.Ref reference ->
OpenApi.Ref reference -> do
type_ <-
Named (fromText (OpenApi.getReference reference))
<$> schemaToType resolver schema
pure (type_, schema ^. OpenApi.extensions)
OpenApi.Inline schema -> do
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
let -- The OpenApi package doesn't expose a way to parse references.
-- 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.
-- 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
| Just allOfsRefs <- OpenApi._schemaAllOf schema = do
AllOf <$> traverse (schemaRefToType resolver) allOfsRefs
@ -270,7 +286,8 @@ schemaToType resolver schema
( ObjectType
{ properties = mempty,
requiredProperties = mempty,
additionalProperties = Just FreeForm
additionalProperties = Just FreeForm,
haskellFieldNames = mempty
}
)
)
@ -295,7 +312,8 @@ schemaToType resolver schema
( ObjectType
{ properties = 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
-- allOf-schema. This function doesn't do any additional type checking.
schemaToObjectType ::
Monad m =>
(Monad m) =>
Resolver m ->
OpenApi.Schema ->
m (ObjectType (Named Type))
schemaToObjectType resolver schema = do
properties <-
propertiesWithExtensions <-
traverse
(schemaRefToType resolver)
(schemaRefToType_ resolver)
(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
Nothing ->
pure Nothing
@ -329,7 +367,9 @@ schemaToObjectType resolver schema = do
properties =
HashMap.fromList (map (first fromText) (HashMap.toList properties)),
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
@ -519,7 +559,8 @@ isObjectType ty = case ty of
ObjectType
{ properties = mempty,
requiredProperties = mempty,
additionalProperties = Nothing
additionalProperties = Nothing,
haskellFieldNames = mempty
}
-- Combine two ObjectTypes. Doesn't report common fields! Also merging
@ -540,11 +581,12 @@ isObjectType ty = case ty of
(Just x, Just y) ->
-- This might be controversial, OTOH definining additional properties on both
-- objects is undefined behavior anyways.
Just FreeForm
Just FreeForm,
haskellFieldNames = haskellFieldNames o1 <> haskellFieldNames o2
}
normalizeNamedType ::
Monad m =>
(Monad m) =>
-- | 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
-- thing (tm).
@ -574,7 +616,7 @@ normalizeNamedType assignName namedType = case namedType of
pure (namedType, [])
normalizeObjectType ::
Monad m =>
(Monad m) =>
-- | Assign a name to an anonnymous type in a field of an 'ObjectType'
(Name -> m Name) ->
-- | Assign a name to the additionalProperties type of an 'ObjectType'
@ -600,7 +642,7 @@ normalizeObjectType assignObjectFieldTypeName assignAdditionaPropertiesTypeName
pure (objectType {additionalProperties, properties}, newTypes <> newTypes')
normalizeVariants ::
Monad m =>
(Monad m) =>
(Int -> m Name) ->
[Named Type] ->
m ([Named Type], [(Name, Type)])
@ -622,7 +664,7 @@ normalizeVariants assignName variants = runWriterT $
-- - top-level definitions
-- - inline definitions that we just assigned a name
normalizeTypeShallow ::
Monad m =>
(Monad m) =>
-- | Assign a name to an anonnymous type in a field of an 'ObjectType'
(Name -> Name -> m Name) ->
-- | 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.
-- Returns the normalized 'Type' alongside with the additional inline definitions.
normalizeType ::
Monad m =>
(Monad m) =>
-- | Assign a name to an anonnymous type in a field of an 'ObjectType'
(Name -> Name -> m Name) ->
-- | 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
-- to the given output directory.
fileWriter :: MonadIO m => FilePath -> Writer m
fileWriter :: (MonadIO m) => FilePath -> Writer m
fileWriter outputDirectory path doc = liftIO $ do
let fullPath = outputDirectory </> path
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
-- 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
ref <- liftIO (newIORef [])
result <- action $ \file doc ->

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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