From 88a755f368a8f31aed1f6c2679b41e9f6269f23d Mon Sep 17 00:00:00 2001 From: Anthony Oliveri Date: Tue, 14 Mar 2017 15:02:34 -0500 Subject: [PATCH 1/7] [Swift] Detect file type in Swift codegen --- .../java/io/swagger/codegen/languages/Swift3Codegen.java | 5 +++++ .../java/io/swagger/codegen/languages/SwiftCodegen.java | 7 ++++++- 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/Swift3Codegen.java b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/Swift3Codegen.java index 7c45302d43a..248bfb24098 100644 --- a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/Swift3Codegen.java +++ b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/Swift3Codegen.java @@ -278,6 +278,11 @@ public class Swift3Codegen extends DefaultCodegen implements CodegenConfig { return toModelName(type); } + @Override + public boolean isDataTypeFile(String dataType) { + return dataType != null && dataType.equals("URL"); + } + @Override public boolean isDataTypeBinary(final String dataType) { return dataType != null && dataType.equals("Data"); diff --git a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/SwiftCodegen.java b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/SwiftCodegen.java index 1a12f287471..cdfcc58a109 100644 --- a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/SwiftCodegen.java +++ b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/SwiftCodegen.java @@ -276,9 +276,14 @@ public class SwiftCodegen extends DefaultCodegen implements CodegenConfig { return toModelName(type); } + @Override + public boolean isDataTypeFile(String dataType) { + return dataType != null && dataType.equals("NSURL"); + } + @Override public boolean isDataTypeBinary(final String dataType) { - return dataType != null && dataType.equals("NSData"); + return dataType != null && dataType.equals("NSData"); } /** From 64c2eed9722d8324ffe3e86895d8340293c29fac Mon Sep 17 00:00:00 2001 From: wing328 Date: Fri, 17 Mar 2017 01:05:14 +0800 Subject: [PATCH 2/7] fix link to Cummins --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 8c3bad5a30c..88d7e54ce61 100644 --- a/README.md +++ b/README.md @@ -838,7 +838,7 @@ Here are some companies/projects using Swagger Codegen in production. To add you - [carpolo](http://www.carpolo.co/) - [CloudBoost](https://www.CloudBoost.io/) - [Conplement](http://www.conplement.de/) -- [Cummins] (http://www.cummins.com/) +- [Cummins](http://www.cummins.com/) - [Cupix](http://www.cupix.com) - [DBBest Technologies](https://www.dbbest.com) - [DecentFoX](http://decentfox.com/) From 20580f9b1ba398b9d04531003664c41f0c3a832a Mon Sep 17 00:00:00 2001 From: Tony Tam Date: Thu, 16 Mar 2017 16:01:34 -0700 Subject: [PATCH 3/7] Update wordnik.yaml --- modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml b/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml index 5d46e5a8b7e..1ca80d26b24 100644 --- a/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml +++ b/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml @@ -412,8 +412,6 @@ paths: $ref: '#/definitions/ExampleSearchResults' '400': description: Invalid word supplied. - '400': - description: Invalid word supplied. '/account.json/authenticate/{username}': get: tags: @@ -1640,4 +1638,4 @@ definitions: format: double mi: type: number - format: double \ No newline at end of file + format: double From 9ddf28ff757ee0fd0ea374e5f10b5c6900222f1e Mon Sep 17 00:00:00 2001 From: Tony Tam Date: Thu, 16 Mar 2017 16:04:59 -0700 Subject: [PATCH 4/7] Update wordnik.yaml --- modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml | 1 - 1 file changed, 1 deletion(-) diff --git a/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml b/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml index 1ca80d26b24..ce95ec32539 100644 --- a/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml +++ b/modules/swagger-codegen/src/test/resources/2_0/wordnik.yaml @@ -739,7 +739,6 @@ paths: type: array items: $ref: '#/definitions/WordListWord' - $ref: '#/definitions/WordListWord' '400': description: Invalid ID supplied '403': From 436cbb6b3da6c5c8336448c679ad49e8a91188f4 Mon Sep 17 00:00:00 2001 From: wing328 Date: Fri, 17 Mar 2017 16:43:08 +0800 Subject: [PATCH 5/7] add https://github.com/christopheradams/elixir_style_guide --- CONTRIBUTING.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index e0b6576bf95..43361418c8e 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -34,6 +34,7 @@ Code change should conform to the programming style guide of the respective lang - C#: https://msdn.microsoft.com/en-us/library/vstudio/ff926074.aspx - C++: https://google.github.io/styleguide/cppguide.html - Clojure: https://github.com/bbatsov/clojure-style-guide +- Elixir: https://github.com/christopheradams/elixir_style_guide - Haskell: https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md - Java: https://google.github.io/styleguide/javaguide.html - JavaScript: https://github.com/airbnb/javascript/ From 65d5b5001f86ca7898526ad43c38042a9bfa64b1 Mon Sep 17 00:00:00 2001 From: wing328 Date: Fri, 17 Mar 2017 16:44:21 +0800 Subject: [PATCH 6/7] add https://github.com/inaka/erlang_guidelines --- CONTRIBUTING.md | 1 + 1 file changed, 1 insertion(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index 43361418c8e..2d56048159f 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -35,6 +35,7 @@ Code change should conform to the programming style guide of the respective lang - C++: https://google.github.io/styleguide/cppguide.html - Clojure: https://github.com/bbatsov/clojure-style-guide - Elixir: https://github.com/christopheradams/elixir_style_guide +- Erlang: https://github.com/inaka/erlang_guidelines - Haskell: https://github.com/tibbe/haskell-style-guide/blob/master/haskell-style.md - Java: https://google.github.io/styleguide/javaguide.html - JavaScript: https://github.com/airbnb/javascript/ From 5ed94a002ce77bc82eea928e8be9b7e508ceb80b Mon Sep 17 00:00:00 2001 From: Sebastian Mandrean Date: Fri, 17 Mar 2017 09:55:11 +0100 Subject: [PATCH 7/7] [Haskell] Fix broken client/server compilation errors (#5097) * Remove dead legacy code * Update cosmetics according to Haskell standard practices * Fix failing pattern matching for lookupEither * Bump to latest dependencies without any breaking changes * Remove duplicate instance declarations already existing in Servant.API.Verbs * Fix double Java/Haskell escapement bug * Re-generate Petstore sample client/server --- .../languages/HaskellServantCodegen.java | 6 + .../resources/haskell-servant/API.mustache | 162 ++++++++------ .../resources/haskell-servant/Types.mustache | 29 +-- .../resources/haskell-servant/stack.mustache | 8 +- .../petstore/haskell-servant/client/Main.hs | 35 --- .../haskell-servant-codegen.cabal | 64 ------ .../haskell-servant/lib/Api/PetApi.hs | 113 ---------- .../haskell-servant/lib/Api/StoreApi.hs | 67 ------ .../haskell-servant/lib/Api/UserApi.hs | 82 ------- .../petstore/haskell-servant/lib/Apis.hs | 24 -- .../haskell-servant/lib/Model/Category.hs | 24 -- .../haskell-servant/lib/Model/Order.hs | 28 --- .../petstore/haskell-servant/lib/Model/Pet.hs | 30 --- .../petstore/haskell-servant/lib/Model/Tag.hs | 24 -- .../haskell-servant/lib/Model/User.hs | 30 --- .../lib/SwaggerPetstore/API.hs | 211 ++++++++++-------- .../lib/SwaggerPetstore/Types.hs | 163 ++++++++------ .../petstore/haskell-servant/lib/Utils.hs | 27 --- .../petstore/haskell-servant/server/Main.hs | 13 -- .../petstore/haskell-servant/stack.yaml | 8 +- 20 files changed, 335 insertions(+), 813 deletions(-) delete mode 100644 samples/server/petstore/haskell-servant/client/Main.hs delete mode 100644 samples/server/petstore/haskell-servant/haskell-servant-codegen.cabal delete mode 100644 samples/server/petstore/haskell-servant/lib/Api/PetApi.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Api/StoreApi.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Api/UserApi.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Apis.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Model/Category.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Model/Order.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Model/Pet.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Model/Tag.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Model/User.hs delete mode 100644 samples/server/petstore/haskell-servant/lib/Utils.hs delete mode 100644 samples/server/petstore/haskell-servant/server/Main.hs diff --git a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java index 96a8a7bb926..b7a2462ab23 100644 --- a/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java +++ b/modules/swagger-codegen/src/main/java/io/swagger/codegen/languages/HaskellServantCodegen.java @@ -54,6 +54,12 @@ public class HaskellServantCodegen extends DefaultCodegen implements CodegenConf specialCharReplacements.put(">", "GreaterThan"); specialCharReplacements.put("<", "LessThan"); + // backslash and double quote need double the escapement for both Java and Haskell + specialCharReplacements.remove("\\"); + specialCharReplacements.remove("\""); + specialCharReplacements.put("\\\\", "Back_Slash"); + specialCharReplacements.put("\\\"", "Double_Quote"); + // set the output folder here outputFolder = "generated-code/haskell-servant"; diff --git a/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache b/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache index 82cc63c8055..14b037cd375 100644 --- a/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache +++ b/modules/swagger-codegen/src/main/resources/haskell-servant/API.mustache @@ -1,65 +1,79 @@ -{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, FlexibleInstances, OverloadedStrings, ViewPatterns #-} -{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, DeriveTraversable, FlexibleContexts, DeriveGeneric #-} -{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack={{contextStackLimit}} #-} -module {{title}}.API ( +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC +-fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack=328 #-} + +module {{title}}.API -- * Client and Server - ServerConfig(..), - {{title}}Backend, - create{{title}}Client, - run{{title}}Server, - run{{title}}Client, - run{{title}}ClientWithManager, - {{title}}Client, + ( ServerConfig(..) + , {{title}}Backend + , create{{title}}Client + , run{{title}}Server + , run{{title}}Client + , run{{title}}ClientWithManager + , {{title}}Client -- ** Servant - {{title}}API, + , {{title}}API ) where import {{title}}.Types +import Control.Monad.Except (ExceptT) +import Control.Monad.IO.Class import Data.Aeson (Value) import Data.Coerce (coerce) -import Servant.API -import Servant (serve, ServantErr) -import Web.HttpApiData -import qualified Network.Wai.Handler.Warp as Warp -import qualified Data.Text as T -import Data.Text (Text) -import Servant.Common.BaseUrl(BaseUrl(..)) -import Servant.Client (ServantError, client, Scheme(Http)) -import Data.Proxy (Proxy(..)) -import Control.Monad.IO.Class import Data.Function ((&)) -import GHC.Exts (IsString(..)) import qualified Data.Map as Map -import GHC.Generics (Generic) import Data.Monoid ((<>)) -import Servant.API.Verbs (Verb, StdMethod(..)) -import Control.Monad.Except (ExceptT) -import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) +import Data.Proxy (Proxy(..)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Exts (IsString(..)) +import GHC.Generics (Generic) +import Network.HTTP.Client (Manager, defaultManagerSettings, newManager) import Network.HTTP.Types.Method (methodOptions) - -instance ReflectMethod 'OPTIONS where - reflectMethod _ = methodOptions +import qualified Network.Wai.Handler.Warp as Warp +import Servant (ServantErr, serve) +import Servant.API +import Servant.API.Verbs (StdMethod(..), Verb) +import Servant.Client (Scheme(Http), ServantError, client) +import Servant.Common.BaseUrl (BaseUrl(..)) +import Web.HttpApiData {{#apiInfo}}{{#apis}}{{#operations}}{{#operation}}{{#hasFormParams}} data {{vendorExtensions.x-formName}} = {{vendorExtensions.x-formName}} - { {{#formParams}}{{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} :: {{dataType}}{{#hasMore}} - , {{/hasMore}}{{/formParams}} - } deriving (Show, Eq, Generic) + { {{#formParams}}{{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} :: {{dataType}}{{#hasMore}} + , {{/hasMore}}{{/formParams}} + } deriving (Show, Eq, Generic) instance FromFormUrlEncoded {{vendorExtensions.x-formName}} where - fromFormUrlEncoded inputs = {{vendorExtensions.x-formName}} <$> {{#formParams}} lookupEither "{{baseName}}" inputs{{#hasMore}} <*> {{/hasMore}}{{/formParams}} + fromFormUrlEncoded inputs = {{vendorExtensions.x-formName}} <$> {{#formParams}}lookupEither "{{baseName}}" inputs{{#hasMore}} <*> {{/hasMore}}{{/formParams}} + instance ToFormUrlEncoded {{vendorExtensions.x-formName}} where - toFormUrlEncoded value = [{{#formParams}}("{{baseName}}", toQueryParam $ {{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} value){{#hasMore}}, {{/hasMore}}{{/formParams}}] -{{/hasFormParams}}{{/operation}}{{/operations}}{{/apis}}{{/apiInfo}} + toFormUrlEncoded value = + [ {{#formParams}}("{{baseName}}", toQueryParam $ {{vendorExtensions.x-formPrefix}}{{vendorExtensions.x-formParamName}} value){{#hasMore}} + , {{/hasMore}}{{/formParams}} + ]{{/hasFormParams}}{{/operation}}{{/operations}}{{/apis}}{{/apiInfo}} -- For the form data code generation. -lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either Text b +lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either String b lookupEither key assocs = case lookup key assocs of - Nothing -> Left $ "Could not find parameter " <> key <> " in form data" - Just value -> parseQueryParam value + Nothing -> Left $ "Could not find parameter " <> (T.unpack key) <> " in form data" + Just value -> + case parseQueryParam value of + Left result -> Left $ T.unpack result + Right result -> Right $ result {{#apiInfo}} -- | Servant type-level API, generated from the Swagger spec for {{title}}. @@ -70,54 +84,56 @@ type {{title}}API {{/apiInfo}} -- | Server or client configuration, specifying the host and port to query or serve on. -data ServerConfig = ServerConfig { - configHost :: String, -- ^ Hostname to serve on, e.g. "127.0.0.1" - configPort :: Int -- ^ Port to serve on, e.g. 8080 +data ServerConfig = ServerConfig + { configHost :: String -- ^ Hostname to serve on, e.g. "127.0.0.1" + , configPort :: Int -- ^ Port to serve on, e.g. 8080 } deriving (Eq, Ord, Show, Read) -- | List of elements parsed from a query. -newtype QueryList (p :: CollectionFormat) a = QueryList { fromQueryList :: [a] } - deriving (Functor, Applicative, Monad, Foldable, Traversable) +newtype QueryList (p :: CollectionFormat) a = QueryList + { fromQueryList :: [a] + } deriving (Functor, Applicative, Monad, Foldable, Traversable) -- | Formats in which a list can be encoded into a HTTP path. -data CollectionFormat = CommaSeparated -- ^ CSV format for multiple parameters. - | SpaceSeparated -- ^ Also called "SSV" - | TabSeparated -- ^ Also called "TSV" - | PipeSeparated -- ^ `value1|value2|value2` - | MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params. +data CollectionFormat + = CommaSeparated -- ^ CSV format for multiple parameters. + | SpaceSeparated -- ^ Also called "SSV" + | TabSeparated -- ^ Also called "TSV" + | PipeSeparated -- ^ `value1|value2|value2` + | MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params. instance FromHttpApiData a => FromHttpApiData (QueryList 'CommaSeparated a) where - parseQueryParam = parseSeparatedQueryList ',' + parseQueryParam = parseSeparatedQueryList ',' instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where - parseQueryParam = parseSeparatedQueryList '\t' + parseQueryParam = parseSeparatedQueryList '\t' instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where - parseQueryParam = parseSeparatedQueryList ' ' + parseQueryParam = parseSeparatedQueryList ' ' instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where - parseQueryParam = parseSeparatedQueryList '|' + parseQueryParam = parseSeparatedQueryList '|' instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where - parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format" + parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format" parseSeparatedQueryList :: FromHttpApiData a => Char -> Text -> Either Text (QueryList p a) parseSeparatedQueryList char = fmap QueryList . mapM parseQueryParam . T.split (== char) instance ToHttpApiData a => ToHttpApiData (QueryList 'CommaSeparated a) where - toQueryParam = formatSeparatedQueryList ',' + toQueryParam = formatSeparatedQueryList ',' instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where - toQueryParam = formatSeparatedQueryList '\t' + toQueryParam = formatSeparatedQueryList '\t' instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where - toQueryParam = formatSeparatedQueryList ' ' + toQueryParam = formatSeparatedQueryList ' ' instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where - toQueryParam = formatSeparatedQueryList '|' + toQueryParam = formatSeparatedQueryList '|' instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where - toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format" + toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format" formatSeparatedQueryList :: ToHttpApiData a => Char -> QueryList p a -> Text formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryParam . fromQueryList @@ -128,26 +144,29 @@ formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryPa -- The backend can be used both for the client and the server. The client generated from the {{title}} Swagger spec -- is a backend that executes actions by sending HTTP requests (see @create{{title}}Client@). Alternatively, provided -- a backend, the API can be served using @run{{title}}Server@. -data {{title}}Backend m = {{title}}Backend { - {{#apis}}{{#operations}}{{#operation}}{{operationId}} :: {{& vendorExtensions.x-clientType}}{- ^ {{& notes}} -}{{#hasMore}}, - {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}}, - {{/hasMore}}{{/apis}} +data {{title}}Backend m = {{title}}Backend + { {{#apis}}{{#operations}}{{#operation}}{{operationId}} :: {{& vendorExtensions.x-clientType}}{- ^ {{& notes}} -}{{#hasMore}} + , {{/hasMore}}{{/operation}}{{/operations}}{{#hasMore}} + , {{/hasMore}}{{/apis}} } -newtype {{title}}Client a = {{title}}Client { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a } - deriving Functor +newtype {{title}}Client a = {{title}}Client + { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a + } deriving Functor instance Applicative {{title}}Client where - pure x = {{title}}Client (\_ _ -> pure x) - ({{title}}Client f) <*> ({{title}}Client x) = {{title}}Client (\manager url -> f manager url <*> x manager url) + pure x = {{title}}Client (\_ _ -> pure x) + ({{title}}Client f) <*> ({{title}}Client x) = + {{title}}Client (\manager url -> f manager url <*> x manager url) instance Monad {{title}}Client where - ({{title}}Client a) >>= f = {{title}}Client (\manager url -> do - value <- a manager url - runClient (f value) manager url) + ({{title}}Client a) >>= f = + {{title}}Client (\manager url -> do + value <- a manager url + runClient (f value) manager url) instance MonadIO {{title}}Client where - liftIO io = {{title}}Client (\_ _ -> liftIO io) + liftIO io = {{title}}Client (\_ _ -> liftIO io) {{/apiInfo}} {{#apiInfo}} @@ -175,7 +194,6 @@ run{{title}}ClientWithManager manager clientConfig cl = run{{title}}Server :: MonadIO m => ServerConfig -> {{title}}Backend (ExceptT ServantErr IO) -> m () run{{title}}Server ServerConfig{..} backend = liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy {{title}}API) (serverFromBackend backend) - where warpSettings = Warp.defaultSettings & Warp.setPort configPort & Warp.setHost (fromString configHost) serverFromBackend {{title}}Backend{..} = diff --git a/modules/swagger-codegen/src/main/resources/haskell-servant/Types.mustache b/modules/swagger-codegen/src/main/resources/haskell-servant/Types.mustache index 1ee62c02e1c..d5115471761 100644 --- a/modules/swagger-codegen/src/main/resources/haskell-servant/Types.mustache +++ b/modules/swagger-codegen/src/main/resources/haskell-servant/Types.mustache @@ -5,10 +5,10 @@ module {{title}}.Types ( {{#models}} {{#model}} - {{classname}} (..), + {{classname}} (..), {{/model}} {{/models}} - ) where + ) where import Data.List (stripPrefix) import Data.Maybe (fromMaybe) @@ -29,14 +29,14 @@ import Data.Function ((&)) {{^vendorExtensions.x-customNewtype}} {{^parent}} {{vendorExtensions.x-data}} {{classname}} = {{classname}} - { {{#vars}}{{& name}} :: {{datatype}} -- ^ {{& description}}{{#hasMore}} - , {{/hasMore}}{{/vars}} - } deriving (Show, Eq, Generic) + { {{#vars}}{{& name}} :: {{datatype}} -- ^ {{& description}}{{#hasMore}} + , {{/hasMore}}{{/vars}} + } deriving (Show, Eq, Generic) instance FromJSON {{classname}} where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}") + parseJSON = genericParseJSON (removeFieldLabelPrefix True "{{vendorExtensions.x-prefix}}") instance ToJSON {{classname}} where - toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}") + toJSON = genericToJSON (removeFieldLabelPrefix False "{{vendorExtensions.x-prefix}}") {{/parent}} {{#parent}} newtype {{classname}} = {{classname}} { un{{classname}} :: {{parent}} } @@ -54,12 +54,15 @@ newtype {{classname}} = {{classname}} {{vendorExtensions.x-customNewtype}} deriv removeFieldLabelPrefix :: Bool -> String -> Options removeFieldLabelPrefix forParsing prefix = defaultOptions - { fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars - } + {fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars} where replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars) - specialChars = [{{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{#hasMore}}, {{/hasMore}}{{/specialCharReplacements}}] + specialChars = + [ {{#specialCharReplacements}}("{{&char}}", "{{&replacement}}"){{#hasMore}} + , {{/hasMore}}{{/specialCharReplacements}} + ] mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack - replacer = if forParsing then flip T.replace else T.replace - - + replacer = + if forParsing + then flip T.replace + else T.replace diff --git a/modules/swagger-codegen/src/main/resources/haskell-servant/stack.mustache b/modules/swagger-codegen/src/main/resources/haskell-servant/stack.mustache index bed581391ca..36060148910 100644 --- a/modules/swagger-codegen/src/main/resources/haskell-servant/stack.mustache +++ b/modules/swagger-codegen/src/main/resources/haskell-servant/stack.mustache @@ -1,8 +1,8 @@ resolver: lts-5.11 extra-deps: -- servant-0.6 -- servant-client-0.6 -- servant-server-0.6 -- http-api-data-0.2.2 +- servant-0.8.1 +- servant-client-0.8.1 +- servant-server-0.8.1 +- http-api-data-0.2.4 packages: - '.' diff --git a/samples/server/petstore/haskell-servant/client/Main.hs b/samples/server/petstore/haskell-servant/client/Main.hs deleted file mode 100644 index 718a8587989..00000000000 --- a/samples/server/petstore/haskell-servant/client/Main.hs +++ /dev/null @@ -1,35 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} - -module Main where - -import Control.Monad (void) -import Control.Monad.Trans.Either -import Control.Monad.IO.Class -import Servant.API -import Servant.Client - -import Data.List.Split (splitOn) -import Network.URI (URI (..), URIAuth (..), parseURI) -import Data.Maybe (fromMaybe) -import Test.QuickCheck -import Control.Monad -import Model.User -import Model.Category -import Model.Pet -import Model.Tag -import Model.Order -import Api.UserApi -import Api.PetApi -import Api.StoreApi - --- userClient :: IO () --- userClient = do --- users <- sample' (arbitrary :: Gen String) --- let user = last users --- void . runEitherT $ do --- getUserByName user >>= (liftIO . putStrLn . show) - -main :: IO () -main = putStrLn "Hello Server!" diff --git a/samples/server/petstore/haskell-servant/haskell-servant-codegen.cabal b/samples/server/petstore/haskell-servant/haskell-servant-codegen.cabal deleted file mode 100644 index 9347cee563c..00000000000 --- a/samples/server/petstore/haskell-servant/haskell-servant-codegen.cabal +++ /dev/null @@ -1,64 +0,0 @@ -name: haskell-servant-codegen -version: 0.1.0.0 -synopsis: Swagger-codegen example for Haskell servant -description: Please see README.md -homepage: https://github.com/swagger-api/swagger-codegen#readme -license: Apache-2.0 -license-file: LICENSE -author: Masahiro Yamauchi -maintainer: sgt.yamauchi@gmail.com -copyright: 2015- Masahiro Yamauchi -category: Web -build-type: Simple --- extra-source-files: -cabal-version: >=1.10 - -library - hs-source-dirs: lib - exposed-modules: Utils - , Model.User - , Model.Category - , Model.Pet - , Model.Tag - , Model.Order - , Api.UserApi - , Api.PetApi - , Api.StoreApi - , Apis - ghc-options: -Wall - build-depends: base - , aeson - , text - , split - , containers - , network-uri - , QuickCheck - , servant - , servant-client - default-language: Haskell2010 - -executable client - hs-source-dirs: client - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , either - , transformers - , split - , network-uri - , QuickCheck - , servant - , servant-client - , haskell-servant-codegen - default-language: Haskell2010 - -executable server - hs-source-dirs: server - main-is: Main.hs - ghc-options: -threaded -rtsopts -with-rtsopts=-N - build-depends: base - , warp - , servant-server - , servant-mock - , haskell-servant-codegen - default-language: Haskell2010 diff --git a/samples/server/petstore/haskell-servant/lib/Api/PetApi.hs b/samples/server/petstore/haskell-servant/lib/Api/PetApi.hs deleted file mode 100644 index 62c71f26ec9..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Api/PetApi.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} - -module Api.PetApi ( - updatePet - , addPet - , findPetsByStatus - , findPetsByTags - , getPetById - , updatePetWithForm - , deletePet - , uploadFile - , getPetByIdWithByteArray - , addPetUsingByteArray - , proxyPetApi - , PetApi - ) where - -import GHC.Generics -import Data.Proxy -import Servant.API -import Servant.Client -import Network.URI (URI (..), URIAuth (..), parseURI) -import Data.Maybe (fromMaybe) -import Servant.Common.Text -import Data.List (intercalate) -import qualified Data.Text as T -import Utils -import Test.QuickCheck -import Model.Pet -import Model.Binary - - - - - - -data Formnamestatus = Formnamestatus - { name :: String - , status :: String - } deriving (Show, Eq, Generic) - -instance FromFormUrlEncoded Formnamestatus where - fromFormUrlEncoded inputs = Formnamestatus <$> lkp inputs "name" <*> lkp inputs "status" -instance ToFormUrlEncoded Formnamestatus where - toFormUrlEncoded x = [((T.pack $ show $ Api.PetApi.name x), (T.pack $ show $ Api.PetApi.status x))] -instance Arbitrary Formnamestatus where - arbitrary = Formnamestatus <$> arbitrary <*> arbitrary - - -data FormadditionalMetadatafile = FormadditionalMetadatafile - { additionalMetadata :: String - , file :: FilePath - } deriving (Show, Eq, Generic) - -instance FromFormUrlEncoded FormadditionalMetadatafile where - fromFormUrlEncoded inputs = FormadditionalMetadatafile <$> lkp inputs "additionalMetadata" <*> lkp inputs "file" -instance ToFormUrlEncoded FormadditionalMetadatafile where - toFormUrlEncoded x = [((T.pack $ show $ Api.PetApi.additionalMetadata x), (T.pack $ show $ Api.PetApi.file x))] -instance Arbitrary FormadditionalMetadatafile where - arbitrary = FormadditionalMetadatafile <$> arbitrary <*> arbitrary - - - - -type PetApi = "pet" :> ReqBody '[JSON] Pet :> Put '[JSON] () -- updatePet - :<|> "pet" :> ReqBody '[JSON] Pet :> Post '[JSON] () -- addPet - :<|> "pet" :> "findByStatus" :> QueryParam "status" [String] :> Get '[JSON] [Pet] -- findPetsByStatus - :<|> "pet" :> "findByTags" :> QueryParam "tags" [String] :> Get '[JSON] [Pet] -- findPetsByTags - :<|> "pet" :> Capture "petId" Integer :> Get '[JSON] Pet -- getPetById - :<|> "pet" :> Capture "petId" String :> ReqBody '[FormUrlEncoded] Formnamestatus :> Post '[JSON] () -- updatePetWithForm - :<|> "pet" :> Capture "petId" Integer :> Header "api_key" String :> Delete '[JSON] () -- deletePet - :<|> "pet" :> Capture "petId" Integer :> "uploadImage" :> ReqBody '[FormUrlEncoded] FormadditionalMetadatafile :> Post '[JSON] () -- uploadFile - :<|> "pet" :> Capture "petId" Integer?testing_byte_array=true :> Get '[JSON] Binary -- getPetByIdWithByteArray - :<|> "pet?testing_byte_array=true" :> ReqBody '[JSON] Binary :> Post '[JSON] () -- addPetUsingByteArray - -proxyPetApi :: Proxy PetApi -proxyPetApi = Proxy - - -serverPath :: String -serverPath = "http://petstore.swagger.io/v2" - -parseHostPort :: String -> (String, Int) -parseHostPort path = (host,port) - where - authority = case parseURI path of - Just x -> uriAuthority x - _ -> Nothing - (host, port) = case authority of - Just y -> (uriRegName y, (getPort . uriPort) y) - _ -> ("localhost", 8080) - getPort p = case (length p) of - 0 -> 80 - _ -> (read . drop 1) p - -(host, port) = parseHostPort serverPath - -updatePet - :<|> addPet - :<|> findPetsByStatus - :<|> findPetsByTags - :<|> getPetById - :<|> updatePetWithForm - :<|> deletePet - :<|> uploadFile - :<|> getPetByIdWithByteArray - :<|> addPetUsingByteArray - = client proxyPetApi $ BaseUrl Http host port diff --git a/samples/server/petstore/haskell-servant/lib/Api/StoreApi.hs b/samples/server/petstore/haskell-servant/lib/Api/StoreApi.hs deleted file mode 100644 index 819da1e5a05..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Api/StoreApi.hs +++ /dev/null @@ -1,67 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} - -module Api.StoreApi ( - getInventory - , placeOrder - , getOrderById - , deleteOrder - , proxyStoreApi - , StoreApi - ) where - -import GHC.Generics -import Data.Proxy -import Servant.API -import Servant.Client -import Network.URI (URI (..), URIAuth (..), parseURI) -import Data.Maybe (fromMaybe) -import Servant.Common.Text -import Data.List (intercalate) -import qualified Data.Text as T -import Utils -import Test.QuickCheck -import qualified Data.Map as Map -import Model.Order - - - - - - -type StoreApi = "store" :> "inventory" :> Get '[JSON] (Map.Map String Integer) -- getInventory - :<|> "store" :> "order" :> ReqBody '[JSON] Order :> Post '[JSON] Order -- placeOrder - :<|> "store" :> "order" :> Capture "orderId" String :> Get '[JSON] Order -- getOrderById - :<|> "store" :> "order" :> Capture "orderId" String :> Delete '[JSON] () -- deleteOrder - -proxyStoreApi :: Proxy StoreApi -proxyStoreApi = Proxy - - -serverPath :: String -serverPath = "http://petstore.swagger.io/v2" - -parseHostPort :: String -> (String, Int) -parseHostPort path = (host,port) - where - authority = case parseURI path of - Just x -> uriAuthority x - _ -> Nothing - (host, port) = case authority of - Just y -> (uriRegName y, (getPort . uriPort) y) - _ -> ("localhost", 8080) - getPort p = case (length p) of - 0 -> 80 - _ -> (read . drop 1) p - -(host, port) = parseHostPort serverPath - -getInventory - :<|> placeOrder - :<|> getOrderById - :<|> deleteOrder - = client proxyStoreApi $ BaseUrl Http host port diff --git a/samples/server/petstore/haskell-servant/lib/Api/UserApi.hs b/samples/server/petstore/haskell-servant/lib/Api/UserApi.hs deleted file mode 100644 index b7c0ad638c5..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Api/UserApi.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} - -module Api.UserApi ( - createUser - , createUsersWithArrayInput - , createUsersWithListInput - , loginUser - , logoutUser - , getUserByName - , updateUser - , deleteUser - , proxyUserApi - , UserApi - ) where - -import GHC.Generics -import Data.Proxy -import Servant.API -import Servant.Client -import Network.URI (URI (..), URIAuth (..), parseURI) -import Data.Maybe (fromMaybe) -import Servant.Common.Text -import Data.List (intercalate) -import qualified Data.Text as T -import Utils -import Test.QuickCheck -import Model.User - - - - - - - - - - -type UserApi = "user" :> ReqBody '[JSON] User :> Post '[JSON] () -- createUser - :<|> "user" :> "createWithArray" :> ReqBody '[JSON] [User] :> Post '[JSON] () -- createUsersWithArrayInput - :<|> "user" :> "createWithList" :> ReqBody '[JSON] [User] :> Post '[JSON] () -- createUsersWithListInput - :<|> "user" :> "login" :> QueryParam "username" String :> QueryParam "password" String :> Get '[JSON] String -- loginUser - :<|> "user" :> "logout" :> Get '[JSON] () -- logoutUser - :<|> "user" :> Capture "username" String :> Get '[JSON] User -- getUserByName - :<|> "user" :> Capture "username" String :> ReqBody '[JSON] User :> Put '[JSON] () -- updateUser - :<|> "user" :> Capture "username" String :> Delete '[JSON] () -- deleteUser - -proxyUserApi :: Proxy UserApi -proxyUserApi = Proxy - - -serverPath :: String -serverPath = "http://petstore.swagger.io/v2" - -parseHostPort :: String -> (String, Int) -parseHostPort path = (host,port) - where - authority = case parseURI path of - Just x -> uriAuthority x - _ -> Nothing - (host, port) = case authority of - Just y -> (uriRegName y, (getPort . uriPort) y) - _ -> ("localhost", 8080) - getPort p = case (length p) of - 0 -> 80 - _ -> (read . drop 1) p - -(host, port) = parseHostPort serverPath - -createUser - :<|> createUsersWithArrayInput - :<|> createUsersWithListInput - :<|> loginUser - :<|> logoutUser - :<|> getUserByName - :<|> updateUser - :<|> deleteUser - = client proxyUserApi $ BaseUrl Http host port diff --git a/samples/server/petstore/haskell-servant/lib/Apis.hs b/samples/server/petstore/haskell-servant/lib/Apis.hs deleted file mode 100644 index 1add14160d4..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Apis.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -module Apis ( - api - , API - ) where - -import Api.UserApi (UserApi) -import Api.PetApi (PetApi) -import Api.StoreApi (StoreApi) - -import Data.Proxy -import Servant.API -import Test.QuickCheck -import qualified Data.Map as Map -import Utils - -type API = UserApi :<|> PetApi :<|> StoreApi - -api :: Proxy API -api = Proxy diff --git a/samples/server/petstore/haskell-servant/lib/Model/Category.hs b/samples/server/petstore/haskell-servant/lib/Model/Category.hs deleted file mode 100644 index 2d7d90776b2..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Model/Category.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Model.Category - ( Category (..) - ) where - -import Data.Aeson -import GHC.Generics -import Test.QuickCheck - - -data Category = Category - { id_ :: Integer - , name :: String - } deriving (Show, Eq, Generic) - -instance FromJSON Category -instance ToJSON Category -instance Arbitrary Category where - arbitrary = Category <$> arbitrary <*> arbitrary diff --git a/samples/server/petstore/haskell-servant/lib/Model/Order.hs b/samples/server/petstore/haskell-servant/lib/Model/Order.hs deleted file mode 100644 index 5c50f4ad85c..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Model/Order.hs +++ /dev/null @@ -1,28 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Model.Order - ( Order (..) - ) where - -import Data.Aeson -import GHC.Generics -import Test.QuickCheck - - -data Order = Order - { id_ :: Integer - , petId :: Integer - , quantity :: Integer - , shipDate :: Integer - , status :: String - , complete :: Bool - } deriving (Show, Eq, Generic) - -instance FromJSON Order -instance ToJSON Order -instance Arbitrary Order where - arbitrary = Order <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/samples/server/petstore/haskell-servant/lib/Model/Pet.hs b/samples/server/petstore/haskell-servant/lib/Model/Pet.hs deleted file mode 100644 index dfe4bb8893a..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Model/Pet.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Model.Pet - ( Pet (..) - ) where - -import Data.Aeson -import GHC.Generics -import Test.QuickCheck -import Model.Category -import Model.Tag - - -data Pet = Pet - { id_ :: Integer - , category :: Category - , name :: String - , photoUrls :: [String] - , tags :: [Tag] - , status :: String - } deriving (Show, Eq, Generic) - -instance FromJSON Pet -instance ToJSON Pet -instance Arbitrary Pet where - arbitrary = Pet <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/samples/server/petstore/haskell-servant/lib/Model/Tag.hs b/samples/server/petstore/haskell-servant/lib/Model/Tag.hs deleted file mode 100644 index 7bbf8feb9b4..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Model/Tag.hs +++ /dev/null @@ -1,24 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Model.Tag - ( Tag (..) - ) where - -import Data.Aeson -import GHC.Generics -import Test.QuickCheck - - -data Tag = Tag - { id_ :: Integer - , name :: String - } deriving (Show, Eq, Generic) - -instance FromJSON Tag -instance ToJSON Tag -instance Arbitrary Tag where - arbitrary = Tag <$> arbitrary <*> arbitrary diff --git a/samples/server/petstore/haskell-servant/lib/Model/User.hs b/samples/server/petstore/haskell-servant/lib/Model/User.hs deleted file mode 100644 index 8ccf875dc7d..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Model/User.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Model.User - ( User (..) - ) where - -import Data.Aeson -import GHC.Generics -import Test.QuickCheck - - -data User = User - { id_ :: Integer - , username :: String - , firstName :: String - , lastName :: String - , email :: String - , password :: String - , phone :: String - , userStatus :: Integer - } deriving (Show, Eq, Generic) - -instance FromJSON User -instance ToJSON User -instance Arbitrary User where - arbitrary = User <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary diff --git a/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/API.hs b/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/API.hs index 75f53f95395..6b9642f716d 100644 --- a/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/API.hs +++ b/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/API.hs @@ -1,75 +1,92 @@ -{-# LANGUAGE DataKinds, TypeFamilies, TypeOperators, FlexibleInstances, OverloadedStrings, ViewPatterns #-} -{-# LANGUAGE RecordWildCards, GeneralizedNewtypeDeriving, DeriveTraversable, FlexibleContexts, DeriveGeneric #-} -{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack=328 #-} -module SwaggerPetstore.API ( +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveTraversable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC +-fno-warn-unused-binds -fno-warn-unused-imports -fcontext-stack=328 #-} + +module SwaggerPetstore.API -- * Client and Server - ServerConfig(..), - SwaggerPetstoreBackend, - createSwaggerPetstoreClient, - runSwaggerPetstoreServer, - runSwaggerPetstoreClient, - runSwaggerPetstoreClientWithManager, - SwaggerPetstoreClient, + ( ServerConfig(..) + , SwaggerPetstoreBackend + , createSwaggerPetstoreClient + , runSwaggerPetstoreServer + , runSwaggerPetstoreClient + , runSwaggerPetstoreClientWithManager + , SwaggerPetstoreClient -- ** Servant - SwaggerPetstoreAPI, + , SwaggerPetstoreAPI ) where import SwaggerPetstore.Types +import Control.Monad.Except (ExceptT) +import Control.Monad.IO.Class import Data.Aeson (Value) import Data.Coerce (coerce) -import Servant.API -import Servant (serve, ServantErr) -import Web.HttpApiData -import qualified Network.Wai.Handler.Warp as Warp -import qualified Data.Text as T -import Data.Text (Text) -import Servant.Common.BaseUrl(BaseUrl(..)) -import Servant.Client (ServantError, client, Scheme(Http)) -import Data.Proxy (Proxy(..)) -import Control.Monad.IO.Class import Data.Function ((&)) -import GHC.Exts (IsString(..)) import qualified Data.Map as Map -import GHC.Generics (Generic) import Data.Monoid ((<>)) -import Servant.API.Verbs (Verb, StdMethod(..)) -import Control.Monad.Except (ExceptT) -import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) +import Data.Proxy (Proxy(..)) +import Data.Text (Text) +import qualified Data.Text as T +import GHC.Exts (IsString(..)) +import GHC.Generics (Generic) +import Network.HTTP.Client (Manager, defaultManagerSettings, newManager) import Network.HTTP.Types.Method (methodOptions) - -instance ReflectMethod 'OPTIONS where - reflectMethod _ = methodOptions +import qualified Network.Wai.Handler.Warp as Warp +import Servant (ServantErr, serve) +import Servant.API +import Servant.API.Verbs (StdMethod(..), Verb) +import Servant.Client (Scheme(Http), ServantError, client) +import Servant.Common.BaseUrl (BaseUrl(..)) +import Web.HttpApiData data FormUpdatePetWithForm = FormUpdatePetWithForm - { updatePetWithFormName :: Text - , updatePetWithFormStatus :: Text - } deriving (Show, Eq, Generic) + { updatePetWithFormName :: Text + , updatePetWithFormStatus :: Text + } deriving (Show, Eq, Generic) instance FromFormUrlEncoded FormUpdatePetWithForm where - fromFormUrlEncoded inputs = FormUpdatePetWithForm <$> lookupEither "name" inputs <*> lookupEither "status" inputs -instance ToFormUrlEncoded FormUpdatePetWithForm where - toFormUrlEncoded value = [("name", toQueryParam $ updatePetWithFormName value), ("status", toQueryParam $ updatePetWithFormStatus value)] + fromFormUrlEncoded inputs = FormUpdatePetWithForm <$> lookupEither "name" inputs <*> lookupEither "status" inputs +instance ToFormUrlEncoded FormUpdatePetWithForm where + toFormUrlEncoded value = + [ ("name", toQueryParam $ updatePetWithFormName value) + , ("status", toQueryParam $ updatePetWithFormStatus value) + ] data FormUploadFile = FormUploadFile - { uploadFileAdditionalMetadata :: Text - , uploadFileFile :: FilePath - } deriving (Show, Eq, Generic) + { uploadFileAdditionalMetadata :: Text + , uploadFileFile :: FilePath + } deriving (Show, Eq, Generic) instance FromFormUrlEncoded FormUploadFile where - fromFormUrlEncoded inputs = FormUploadFile <$> lookupEither "additionalMetadata" inputs <*> lookupEither "file" inputs -instance ToFormUrlEncoded FormUploadFile where - toFormUrlEncoded value = [("additionalMetadata", toQueryParam $ uploadFileAdditionalMetadata value), ("file", toQueryParam $ uploadFileFile value)] + fromFormUrlEncoded inputs = FormUploadFile <$> lookupEither "additionalMetadata" inputs <*> lookupEither "file" inputs +instance ToFormUrlEncoded FormUploadFile where + toFormUrlEncoded value = + [ ("additionalMetadata", toQueryParam $ uploadFileAdditionalMetadata value) + , ("file", toQueryParam $ uploadFileFile value) + ] -- For the form data code generation. -lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either Text b +lookupEither :: FromHttpApiData b => Text -> [(Text, Text)] -> Either String b lookupEither key assocs = case lookup key assocs of - Nothing -> Left $ "Could not find parameter " <> key <> " in form data" - Just value -> parseQueryParam value + Nothing -> Left $ "Could not find parameter " <> (T.unpack key) <> " in form data" + Just value -> + case parseQueryParam value of + Left result -> Left $ T.unpack result + Right result -> Right $ result -- | Servant type-level API, generated from the Swagger spec for SwaggerPetstore. type SwaggerPetstoreAPI @@ -95,54 +112,56 @@ type SwaggerPetstoreAPI :<|> "user" :> Capture "username" Text :> ReqBody '[JSON] User :> Verb 'PUT 200 '[JSON] () -- 'updateUser' route -- | Server or client configuration, specifying the host and port to query or serve on. -data ServerConfig = ServerConfig { - configHost :: String, -- ^ Hostname to serve on, e.g. "127.0.0.1" - configPort :: Int -- ^ Port to serve on, e.g. 8080 +data ServerConfig = ServerConfig + { configHost :: String -- ^ Hostname to serve on, e.g. "127.0.0.1" + , configPort :: Int -- ^ Port to serve on, e.g. 8080 } deriving (Eq, Ord, Show, Read) -- | List of elements parsed from a query. -newtype QueryList (p :: CollectionFormat) a = QueryList { fromQueryList :: [a] } - deriving (Functor, Applicative, Monad, Foldable, Traversable) +newtype QueryList (p :: CollectionFormat) a = QueryList + { fromQueryList :: [a] + } deriving (Functor, Applicative, Monad, Foldable, Traversable) -- | Formats in which a list can be encoded into a HTTP path. -data CollectionFormat = CommaSeparated -- ^ CSV format for multiple parameters. - | SpaceSeparated -- ^ Also called "SSV" - | TabSeparated -- ^ Also called "TSV" - | PipeSeparated -- ^ `value1|value2|value2` - | MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params. +data CollectionFormat + = CommaSeparated -- ^ CSV format for multiple parameters. + | SpaceSeparated -- ^ Also called "SSV" + | TabSeparated -- ^ Also called "TSV" + | PipeSeparated -- ^ `value1|value2|value2` + | MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. Only for GET params. instance FromHttpApiData a => FromHttpApiData (QueryList 'CommaSeparated a) where - parseQueryParam = parseSeparatedQueryList ',' + parseQueryParam = parseSeparatedQueryList ',' instance FromHttpApiData a => FromHttpApiData (QueryList 'TabSeparated a) where - parseQueryParam = parseSeparatedQueryList '\t' + parseQueryParam = parseSeparatedQueryList '\t' instance FromHttpApiData a => FromHttpApiData (QueryList 'SpaceSeparated a) where - parseQueryParam = parseSeparatedQueryList ' ' + parseQueryParam = parseSeparatedQueryList ' ' instance FromHttpApiData a => FromHttpApiData (QueryList 'PipeSeparated a) where - parseQueryParam = parseSeparatedQueryList '|' + parseQueryParam = parseSeparatedQueryList '|' instance FromHttpApiData a => FromHttpApiData (QueryList 'MultiParamArray a) where - parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format" + parseQueryParam = error "unimplemented FromHttpApiData for MultiParamArray collection format" parseSeparatedQueryList :: FromHttpApiData a => Char -> Text -> Either Text (QueryList p a) parseSeparatedQueryList char = fmap QueryList . mapM parseQueryParam . T.split (== char) instance ToHttpApiData a => ToHttpApiData (QueryList 'CommaSeparated a) where - toQueryParam = formatSeparatedQueryList ',' + toQueryParam = formatSeparatedQueryList ',' instance ToHttpApiData a => ToHttpApiData (QueryList 'TabSeparated a) where - toQueryParam = formatSeparatedQueryList '\t' + toQueryParam = formatSeparatedQueryList '\t' instance ToHttpApiData a => ToHttpApiData (QueryList 'SpaceSeparated a) where - toQueryParam = formatSeparatedQueryList ' ' + toQueryParam = formatSeparatedQueryList ' ' instance ToHttpApiData a => ToHttpApiData (QueryList 'PipeSeparated a) where - toQueryParam = formatSeparatedQueryList '|' + toQueryParam = formatSeparatedQueryList '|' instance ToHttpApiData a => ToHttpApiData (QueryList 'MultiParamArray a) where - toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format" + toQueryParam = error "unimplemented ToHttpApiData for MultiParamArray collection format" formatSeparatedQueryList :: ToHttpApiData a => Char -> QueryList p a -> Text formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryParam . fromQueryList @@ -152,43 +171,46 @@ formatSeparatedQueryList char = T.intercalate (T.singleton char) . map toQueryPa -- The backend can be used both for the client and the server. The client generated from the SwaggerPetstore Swagger spec -- is a backend that executes actions by sending HTTP requests (see @createSwaggerPetstoreClient@). Alternatively, provided -- a backend, the API can be served using @runSwaggerPetstoreServer@. -data SwaggerPetstoreBackend m = SwaggerPetstoreBackend { - addPet :: Pet -> m (){- ^ -}, - deletePet :: Integer -> Maybe Text -> m (){- ^ -}, - findPetsByStatus :: Maybe [Text] -> m [Pet]{- ^ Multiple status values can be provided with comma separated strings -}, - findPetsByTags :: Maybe [Text] -> m [Pet]{- ^ Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing. -}, - getPetById :: Integer -> m Pet{- ^ Returns a single pet -}, - updatePet :: Pet -> m (){- ^ -}, - updatePetWithForm :: Integer -> FormUpdatePetWithForm -> m (){- ^ -}, - uploadFile :: Integer -> FormUploadFile -> m ApiResponse{- ^ -}, - deleteOrder :: Text -> m (){- ^ For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors -}, - getInventory :: m (Map.Map String Int){- ^ Returns a map of status codes to quantities -}, - getOrderById :: Integer -> m Order{- ^ For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions -}, - placeOrder :: Order -> m Order{- ^ -}, - createUser :: User -> m (){- ^ This can only be done by the logged in user. -}, - createUsersWithArrayInput :: [User] -> m (){- ^ -}, - createUsersWithListInput :: [User] -> m (){- ^ -}, - deleteUser :: Text -> m (){- ^ This can only be done by the logged in user. -}, - getUserByName :: Text -> m User{- ^ -}, - loginUser :: Maybe Text -> Maybe Text -> m Text{- ^ -}, - logoutUser :: m (){- ^ -}, - updateUser :: Text -> User -> m (){- ^ This can only be done by the logged in user. -} +data SwaggerPetstoreBackend m = SwaggerPetstoreBackend + { addPet :: Pet -> m (){- ^ -} + , deletePet :: Integer -> Maybe Text -> m (){- ^ -} + , findPetsByStatus :: Maybe [Text] -> m [Pet]{- ^ Multiple status values can be provided with comma separated strings -} + , findPetsByTags :: Maybe [Text] -> m [Pet]{- ^ Multiple tags can be provided with comma separated strings. Use tag1, tag2, tag3 for testing. -} + , getPetById :: Integer -> m Pet{- ^ Returns a single pet -} + , updatePet :: Pet -> m (){- ^ -} + , updatePetWithForm :: Integer -> FormUpdatePetWithForm -> m (){- ^ -} + , uploadFile :: Integer -> FormUploadFile -> m ApiResponse{- ^ -} + , deleteOrder :: Text -> m (){- ^ For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors -} + , getInventory :: m (Map.Map String Int){- ^ Returns a map of status codes to quantities -} + , getOrderById :: Integer -> m Order{- ^ For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions -} + , placeOrder :: Order -> m Order{- ^ -} + , createUser :: User -> m (){- ^ This can only be done by the logged in user. -} + , createUsersWithArrayInput :: [User] -> m (){- ^ -} + , createUsersWithListInput :: [User] -> m (){- ^ -} + , deleteUser :: Text -> m (){- ^ This can only be done by the logged in user. -} + , getUserByName :: Text -> m User{- ^ -} + , loginUser :: Maybe Text -> Maybe Text -> m Text{- ^ -} + , logoutUser :: m (){- ^ -} + , updateUser :: Text -> User -> m (){- ^ This can only be done by the logged in user. -} } -newtype SwaggerPetstoreClient a = SwaggerPetstoreClient { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a } - deriving Functor +newtype SwaggerPetstoreClient a = SwaggerPetstoreClient + { runClient :: Manager -> BaseUrl -> ExceptT ServantError IO a + } deriving Functor instance Applicative SwaggerPetstoreClient where - pure x = SwaggerPetstoreClient (\_ _ -> pure x) - (SwaggerPetstoreClient f) <*> (SwaggerPetstoreClient x) = SwaggerPetstoreClient (\manager url -> f manager url <*> x manager url) + pure x = SwaggerPetstoreClient (\_ _ -> pure x) + (SwaggerPetstoreClient f) <*> (SwaggerPetstoreClient x) = + SwaggerPetstoreClient (\manager url -> f manager url <*> x manager url) instance Monad SwaggerPetstoreClient where - (SwaggerPetstoreClient a) >>= f = SwaggerPetstoreClient (\manager url -> do - value <- a manager url - runClient (f value) manager url) + (SwaggerPetstoreClient a) >>= f = + SwaggerPetstoreClient (\manager url -> do + value <- a manager url + runClient (f value) manager url) instance MonadIO SwaggerPetstoreClient where - liftIO io = SwaggerPetstoreClient (\_ _ -> liftIO io) + liftIO io = SwaggerPetstoreClient (\_ _ -> liftIO io) createSwaggerPetstoreClient :: SwaggerPetstoreBackend SwaggerPetstoreClient createSwaggerPetstoreClient = SwaggerPetstoreBackend{..} @@ -229,7 +251,6 @@ runSwaggerPetstoreClientWithManager manager clientConfig cl = runSwaggerPetstoreServer :: MonadIO m => ServerConfig -> SwaggerPetstoreBackend (ExceptT ServantErr IO) -> m () runSwaggerPetstoreServer ServerConfig{..} backend = liftIO $ Warp.runSettings warpSettings $ serve (Proxy :: Proxy SwaggerPetstoreAPI) (serverFromBackend backend) - where warpSettings = Warp.defaultSettings & Warp.setPort configPort & Warp.setHost (fromString configHost) serverFromBackend SwaggerPetstoreBackend{..} = diff --git a/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/Types.hs b/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/Types.hs index 4207fbc90c6..7a6c6d802f8 100644 --- a/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/Types.hs +++ b/samples/server/petstore/haskell-servant/lib/SwaggerPetstore/Types.hs @@ -3,13 +3,13 @@ {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-} module SwaggerPetstore.Types ( - ApiResponse (..), - Category (..), - Order (..), - Pet (..), - Tag (..), - User (..), - ) where + ApiResponse (..), + Category (..), + Order (..), + Pet (..), + Tag (..), + User (..), + ) where import Data.List (stripPrefix) import Data.Maybe (fromMaybe) @@ -22,98 +22,133 @@ import GHC.Generics (Generic) import Data.Function ((&)) --- | +-- | Describes the result of uploading an image resource data ApiResponse = ApiResponse - { apiResponseCode :: Int -- ^ - , apiResponseType_ :: Text -- ^ - , apiResponseMessage :: Text -- ^ - } deriving (Show, Eq, Generic) + { apiResponseCode :: Int -- ^ + , apiResponseType :: Text -- ^ + , apiResponseMessage :: Text -- ^ + } deriving (Show, Eq, Generic) instance FromJSON ApiResponse where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse") + parseJSON = genericParseJSON (removeFieldLabelPrefix True "apiResponse") instance ToJSON ApiResponse where - toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse") + toJSON = genericToJSON (removeFieldLabelPrefix False "apiResponse") --- | +-- | A category for a pet data Category = Category - { categoryId :: Integer -- ^ - , categoryName :: Text -- ^ - } deriving (Show, Eq, Generic) + { categoryId :: Integer -- ^ + , categoryName :: Text -- ^ + } deriving (Show, Eq, Generic) instance FromJSON Category where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "category") + parseJSON = genericParseJSON (removeFieldLabelPrefix True "category") instance ToJSON Category where - toJSON = genericToJSON (removeFieldLabelPrefix False "category") + toJSON = genericToJSON (removeFieldLabelPrefix False "category") --- | +-- | An order for a pets from the pet store data Order = Order - { orderId :: Integer -- ^ - , orderPetId :: Integer -- ^ - , orderQuantity :: Int -- ^ - , orderShipDate :: Integer -- ^ - , orderStatus :: Text -- ^ Order Status - , orderComplete :: Bool -- ^ - } deriving (Show, Eq, Generic) + { orderId :: Integer -- ^ + , orderPetId :: Integer -- ^ + , orderQuantity :: Int -- ^ + , orderShipDate :: Integer -- ^ + , orderStatus :: Text -- ^ Order Status + , orderComplete :: Bool -- ^ + } deriving (Show, Eq, Generic) instance FromJSON Order where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "order") + parseJSON = genericParseJSON (removeFieldLabelPrefix True "order") instance ToJSON Order where - toJSON = genericToJSON (removeFieldLabelPrefix False "order") + toJSON = genericToJSON (removeFieldLabelPrefix False "order") --- | +-- | A pet for sale in the pet store data Pet = Pet - { petId :: Integer -- ^ - , petCategory :: Category -- ^ - , petName :: Text -- ^ - , petPhotoUrls :: [Text] -- ^ - , petTags :: [Tag] -- ^ - , petStatus :: Text -- ^ pet status in the store - } deriving (Show, Eq, Generic) + { petId :: Integer -- ^ + , petCategory :: Category -- ^ + , petName :: Text -- ^ + , petPhotoUrls :: [Text] -- ^ + , petTags :: [Tag] -- ^ + , petStatus :: Text -- ^ pet status in the store + } deriving (Show, Eq, Generic) instance FromJSON Pet where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet") + parseJSON = genericParseJSON (removeFieldLabelPrefix True "pet") instance ToJSON Pet where - toJSON = genericToJSON (removeFieldLabelPrefix False "pet") + toJSON = genericToJSON (removeFieldLabelPrefix False "pet") --- | +-- | A tag for a pet data Tag = Tag - { tagId :: Integer -- ^ - , tagName :: Text -- ^ - } deriving (Show, Eq, Generic) + { tagId :: Integer -- ^ + , tagName :: Text -- ^ + } deriving (Show, Eq, Generic) instance FromJSON Tag where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag") + parseJSON = genericParseJSON (removeFieldLabelPrefix True "tag") instance ToJSON Tag where - toJSON = genericToJSON (removeFieldLabelPrefix False "tag") + toJSON = genericToJSON (removeFieldLabelPrefix False "tag") --- | +-- | A User who is purchasing from the pet store data User = User - { userId :: Integer -- ^ - , userUsername :: Text -- ^ - , userFirstName :: Text -- ^ - , userLastName :: Text -- ^ - , userEmail :: Text -- ^ - , userPassword :: Text -- ^ - , userPhone :: Text -- ^ - , userUserStatus :: Int -- ^ User Status - } deriving (Show, Eq, Generic) + { userId :: Integer -- ^ + , userUsername :: Text -- ^ + , userFirstName :: Text -- ^ + , userLastName :: Text -- ^ + , userEmail :: Text -- ^ + , userPassword :: Text -- ^ + , userPhone :: Text -- ^ + , userUserStatus :: Int -- ^ User Status + } deriving (Show, Eq, Generic) instance FromJSON User where - parseJSON = genericParseJSON (removeFieldLabelPrefix True "user") + parseJSON = genericParseJSON (removeFieldLabelPrefix True "user") instance ToJSON User where - toJSON = genericToJSON (removeFieldLabelPrefix False "user") + toJSON = genericToJSON (removeFieldLabelPrefix False "user") -- Remove a field label prefix during JSON parsing. -- Also perform any replacements for special characters. removeFieldLabelPrefix :: Bool -> String -> Options removeFieldLabelPrefix forParsing prefix = defaultOptions - { fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars - } + {fieldLabelModifier = fromMaybe (error ("did not find prefix " ++ prefix)) . stripPrefix prefix . replaceSpecialChars} where replaceSpecialChars field = foldl (&) field (map mkCharReplacement specialChars) - specialChars = [("#", "'Hash"), ("!", "'Exclamation"), ("&", "'Ampersand"), ("@", "'At"), ("$", "'Dollar"), ("%", "'Percent"), ("*", "'Star"), ("+", "'Plus"), (">=", "'Greater_Than_Or_Equal_To"), ("-", "'Dash"), ("<=", "'Less_Than_Or_Equal_To"), ("!=", "'Greater_Than_Or_Equal_To"), (":", "'Colon"), ("^", "'Caret"), ("|", "'Pipe"), (">", "'GreaterThan"), ("=", "'Equal"), ("<", "'LessThan")] + specialChars = + [ ("@", "'At") + , ("\\", "'Back_Slash") + , ("<=", "'Less_Than_Or_Equal_To") + , ("\"", "'Double_Quote") + , ("[", "'Left_Square_Bracket") + , ("]", "'Right_Square_Bracket") + , ("^", "'Caret") + , ("_", "'Underscore") + , ("`", "'Backtick") + , ("!", "'Exclamation") + , ("#", "'Hash") + , ("$", "'Dollar") + , ("%", "'Percent") + , ("&", "'Ampersand") + , ("'", "'Quote") + , ("(", "'Left_Parenthesis") + , (")", "'Right_Parenthesis") + , ("*", "'Star") + , ("+", "'Plus") + , (",", "'Comma") + , ("-", "'Dash") + , (".", "'Period") + , ("/", "'Slash") + , (":", "'Colon") + , ("{", "'Left_Curly_Bracket") + , ("|", "'Pipe") + , ("<", "'LessThan") + , ("!=", "'Not_Equal") + , ("=", "'Equal") + , ("}", "'Right_Curly_Bracket") + , (">", "'GreaterThan") + , ("~", "'Tilde") + , ("?", "'Question_Mark") + , (">=", "'Greater_Than_Or_Equal_To") + ] mkCharReplacement (replaceStr, searchStr) = T.unpack . replacer (T.pack searchStr) (T.pack replaceStr) . T.pack - replacer = if forParsing then flip T.replace else T.replace - - + replacer = + if forParsing + then flip T.replace + else T.replace diff --git a/samples/server/petstore/haskell-servant/lib/Utils.hs b/samples/server/petstore/haskell-servant/lib/Utils.hs deleted file mode 100644 index f6db2602ce8..00000000000 --- a/samples/server/petstore/haskell-servant/lib/Utils.hs +++ /dev/null @@ -1,27 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE FlexibleInstances #-} -module Utils where - -import GHC.Generics -import Servant.API -import Data.List (intercalate) -import Data.List.Split (splitOn) -import qualified Data.Map as Map -import qualified Data.Text as T -import Test.QuickCheck - -instance FromText [String] where - fromText = Just . splitOn "," . T.unpack - -instance ToText [String] where - toText = T.pack . intercalate "," - -lkp inputs l = case lookup l inputs of - Nothing -> Left $ "label " ++ T.unpack l ++ " not found" - Just v -> Right $ read (T.unpack v) - -instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map.Map k v) where - arbitrary = Map.fromList <$> arbitrary diff --git a/samples/server/petstore/haskell-servant/server/Main.hs b/samples/server/petstore/haskell-servant/server/Main.hs deleted file mode 100644 index 68b4ff6ce33..00000000000 --- a/samples/server/petstore/haskell-servant/server/Main.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE TypeOperators #-} - -module Main where - -import Apis -import Servant -import Servant.Mock -import qualified Network.Wai.Handler.Warp as Warp - -main :: IO () -main = Warp.run 8080 $ serve api (mock api) diff --git a/samples/server/petstore/haskell-servant/stack.yaml b/samples/server/petstore/haskell-servant/stack.yaml index bed581391ca..36060148910 100644 --- a/samples/server/petstore/haskell-servant/stack.yaml +++ b/samples/server/petstore/haskell-servant/stack.yaml @@ -1,8 +1,8 @@ resolver: lts-5.11 extra-deps: -- servant-0.6 -- servant-client-0.6 -- servant-server-0.6 -- http-api-data-0.2.2 +- servant-0.8.1 +- servant-client-0.8.1 +- servant-server-0.8.1 +- http-api-data-0.2.4 packages: - '.'