From e8773632520c2f8f792c689ee96e61ce2c8feb26 Mon Sep 17 00:00:00 2001 From: Alex Biehl Date: Fri, 7 Apr 2023 10:37:04 +0200 Subject: [PATCH] Support x-tie-haskell-name to override field names --- Request.template.hs | 28 +++---- Response.template.hs | 2 +- bin/Main.hs | 14 ++-- src/Tie.hs | 10 +-- src/Tie/Codegen/Operation.hs | 20 +++-- src/Tie/Codegen/Response.hs | 2 +- src/Tie/Codegen/Schema.hs | 38 ++++++---- src/Tie/Operation.hs | 59 +++++++-------- src/Tie/Resolve.hs | 4 +- src/Tie/Type.hs | 86 ++++++++++++++++------ src/Tie/Writer.hs | 4 +- test/golden/additional-properties.yaml.out | 30 ++++---- test/golden/bug-1.yaml.out | 30 ++++---- test/golden/csv.yaml.out | 30 ++++---- test/golden/datetime.yaml.out | 30 ++++---- test/golden/enum-bug.yaml.out | 30 ++++---- test/golden/enum.yaml.out | 30 ++++---- test/golden/haskell-ext.yaml | 5 +- test/golden/haskell-ext.yaml.out | 42 ++++++----- test/golden/headers.yaml.out | 30 ++++---- test/golden/lists.yaml.out | 30 ++++---- test/golden/numbers.yaml.out | 30 ++++---- test/golden/object-without-type.yaml.out | 30 ++++---- test/golden/oneof.yaml.out | 30 ++++---- test/golden/petstore.yaml.out | 30 ++++---- test/golden/test1.yaml.out | 30 ++++---- 26 files changed, 385 insertions(+), 319 deletions(-) diff --git a/Request.template.hs b/Request.template.hs index 58fc131..a9edfc3 100644 --- a/Request.template.hs +++ b/Request.template.hs @@ -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. diff --git a/Response.template.hs b/Response.template.hs index 320c7e9..8c7f54a 100644 --- a/Response.template.hs +++ b/Response.template.hs @@ -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 diff --git a/bin/Main.hs b/bin/Main.hs index 0c5adf6..5a99a65 100644 --- a/bin/Main.hs +++ b/bin/Main.hs @@ -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,10 +82,12 @@ options = ) versioner :: Parser (a -> a) -versioner = infoOption ("tie " <> showVersion version) - ( long "version" - <> help "Print Tie version" - ) +versioner = + infoOption + ("tie " <> showVersion version) + ( long "version" + <> help "Print Tie version" + ) main :: IO () main = do diff --git a/src/Tie.hs b/src/Tie.hs index 8f3c733..f4e136c 100644 --- a/src/Tie.hs +++ b/src/Tie.hs @@ -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 -> diff --git a/src/Tie/Codegen/Operation.hs b/src/Tie/Codegen/Operation.hs index 1911a46..10d5939 100644 --- a/src/Tie/Codegen/Operation.hs +++ b/src/Tie/Codegen/Operation.hs @@ -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 $ @@ -164,7 +164,7 @@ codegenApiTypeOperation resolver Operation {..} = do (\x y -> x <+> "->" <> PP.line <> y) ( paramsCode ++ [ codegenRequestBodyComment body <> codegenRequestBodyType body - | Just body<- [requestBody] + | Just body <- [requestBody] ] ++ ["m" <+> toApiResponseTypeName name] ) @@ -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 diff --git a/src/Tie/Codegen/Response.hs b/src/Tie/Codegen/Response.hs index df3bb71..9814725 100644 --- a/src/Tie/Codegen/Response.hs +++ b/src/Tie/Codegen/Response.hs @@ -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 -> diff --git a/src/Tie/Codegen/Schema.hs b/src/Tie/Codegen/Schema.hs index cb6facf..2e0a130 100644 --- a/src/Tie/Codegen/Schema.hs +++ b/src/Tie/Codegen/Schema.hs @@ -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 diff --git a/src/Tie/Operation.hs b/src/Tie/Operation.hs index d62e051..77d84e4 100644 --- a/src/Tie/Operation.hs +++ b/src/Tie/Operation.hs @@ -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,30 +304,31 @@ operationToOperation resolver errors@Errors {..} method path params OpenApi.Oper } requestBodyToRequestBody :: - Monad m => + (Monad m) => Resolver m -> Errors m -> OpenApi.RequestBody -> m RequestBody requestBodyToRequestBody resolver Errors {..} requestBody = do - let extensions = + let extensions = 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 - | otherwise = - False + provideRequestBodyAsStream + | 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), - InsOrd.lookup "application/x-ndjson" (OpenApi._requestBodyContent requestBody) - ] - ) - (traceShow requestBody $ unsupportedMediaType) + OpenApi.MediaTypeObject {..} <- + whenNothing + ( asum + [ InsOrd.lookup "application/json" (OpenApi._requestBodyContent requestBody), + InsOrd.lookup "application/x-ndjson" (OpenApi._requestBodyContent requestBody) + ] + ) + (traceShow requestBody $ unsupportedMediaType) referencedSchema <- whenNothing _mediaTypeObjectSchema @@ -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 diff --git a/src/Tie/Resolve.hs b/src/Tie/Resolve.hs index 694f885..605ca23 100644 --- a/src/Tie/Resolve.hs +++ b/src/Tie/Resolve.hs @@ -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 diff --git a/src/Tie/Type.hs b/src/Tie/Type.hs index 4ea8dbf..83cc451 100644 --- a/src/Tie/Type.hs +++ b/src/Tie/Type.hs @@ -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 -> - Named (fromText (OpenApi.getReference reference)) - <$> schemaToType resolver schema + OpenApi.Ref reference -> do + type_ <- + Named (fromText (OpenApi.getReference reference)) + <$> schemaToType resolver schema + pure (type_, schema ^. OpenApi.extensions) 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 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' diff --git a/src/Tie/Writer.hs b/src/Tie/Writer.hs index 267f822..7e0b1cb 100644 --- a/src/Tie/Writer.hs +++ b/src/Tie/Writer.hs @@ -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 -> diff --git a/test/golden/additional-properties.yaml.out b/test/golden/additional-properties.yaml.out index 19096d8..2c00188 100644 --- a/test/golden/additional-properties.yaml.out +++ b/test/golden/additional-properties.yaml.out @@ -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 diff --git a/test/golden/bug-1.yaml.out b/test/golden/bug-1.yaml.out index 86d7399..eae24a2 100644 --- a/test/golden/bug-1.yaml.out +++ b/test/golden/bug-1.yaml.out @@ -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 diff --git a/test/golden/csv.yaml.out b/test/golden/csv.yaml.out index 64377cb..64bdbc9 100644 --- a/test/golden/csv.yaml.out +++ b/test/golden/csv.yaml.out @@ -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 diff --git a/test/golden/datetime.yaml.out b/test/golden/datetime.yaml.out index e682764..b4dd669 100644 --- a/test/golden/datetime.yaml.out +++ b/test/golden/datetime.yaml.out @@ -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 diff --git a/test/golden/enum-bug.yaml.out b/test/golden/enum-bug.yaml.out index c974f26..73ad722 100644 --- a/test/golden/enum-bug.yaml.out +++ b/test/golden/enum-bug.yaml.out @@ -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 diff --git a/test/golden/enum.yaml.out b/test/golden/enum.yaml.out index 7e843fe..b8c1502 100644 --- a/test/golden/enum.yaml.out +++ b/test/golden/enum.yaml.out @@ -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 diff --git a/test/golden/haskell-ext.yaml b/test/golden/haskell-ext.yaml index 5e5a1d5..d8403aa 100644 --- a/test/golden/haskell-ext.yaml +++ b/test/golden/haskell-ext.yaml @@ -47,4 +47,7 @@ components: properties: test1: type: string - x-tie-haskell-type: Scarf.Hashids.Hashid Int32 \ No newline at end of file + x-tie-haskell-type: Scarf.Hashids.Hashid Int32 + test2: + type: string + x-tie-haskell-name: abcdef \ No newline at end of file diff --git a/test/golden/haskell-ext.yaml.out b/test/golden/haskell-ext.yaml.out index 0c29800..79ae9ff 100644 --- a/test/golden/haskell-ext.yaml.out +++ b/test/golden/haskell-ext.yaml.out @@ -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 diff --git a/test/golden/headers.yaml.out b/test/golden/headers.yaml.out index 50b80ed..4445152 100644 --- a/test/golden/headers.yaml.out +++ b/test/golden/headers.yaml.out @@ -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 diff --git a/test/golden/lists.yaml.out b/test/golden/lists.yaml.out index 77843f6..5417d24 100644 --- a/test/golden/lists.yaml.out +++ b/test/golden/lists.yaml.out @@ -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 diff --git a/test/golden/numbers.yaml.out b/test/golden/numbers.yaml.out index 0eb0c23..6069d49 100644 --- a/test/golden/numbers.yaml.out +++ b/test/golden/numbers.yaml.out @@ -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 diff --git a/test/golden/object-without-type.yaml.out b/test/golden/object-without-type.yaml.out index 2c1c42d..ff7e6f5 100644 --- a/test/golden/object-without-type.yaml.out +++ b/test/golden/object-without-type.yaml.out @@ -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 diff --git a/test/golden/oneof.yaml.out b/test/golden/oneof.yaml.out index a28dc6a..d863fab 100644 --- a/test/golden/oneof.yaml.out +++ b/test/golden/oneof.yaml.out @@ -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 diff --git a/test/golden/petstore.yaml.out b/test/golden/petstore.yaml.out index 9fcd6ca..90ca27c 100644 --- a/test/golden/petstore.yaml.out +++ b/test/golden/petstore.yaml.out @@ -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 diff --git a/test/golden/test1.yaml.out b/test/golden/test1.yaml.out index c54f858..22b06d3 100644 --- a/test/golden/test1.yaml.out +++ b/test/golden/test1.yaml.out @@ -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