diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,18 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-foreign/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.15 +---- + +- *servant-foreign* Add support so `HasForeign` can be implemented for + `MultipartForm` from [`servant-multipart`](http://hackage.haskell.org/package/servant-multipart) + [#1035](https://github.com/haskell-servant/servant/pull/1035) + +- Drop support for GHC older than 8.0 + [#1008](https://github.com/haskell-servant/servant/pull/1008) + [#1009](https://github.com/haskell-servant/servant/pull/1009) + + 0.11.1 ------ diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, Servant Contributors +Copyright (c) 2014-2016, Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors All rights reserved. diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/include/overlapping-compat.h b/include/overlapping-compat.h deleted file mode 100644 --- a/include/overlapping-compat.h +++ /dev/null @@ -1,8 +0,0 @@ -#if __GLASGOW_HASKELL__ >= 710 -#define OVERLAPPABLE_ {-# OVERLAPPABLE #-} -#define OVERLAPPING_ {-# OVERLAPPING #-} -#else -{-# LANGUAGE OverlappingInstances #-} -#define OVERLAPPABLE_ -#define OVERLAPPING_ -#endif diff --git a/servant-foreign.cabal b/servant-foreign.cabal --- a/servant-foreign.cabal +++ b/servant-foreign.cabal @@ -1,6 +1,9 @@ +cabal-version: >=1.10 name: servant-foreign -version: 0.11.1 +version: 0.15 + synopsis: Helpers for generating clients for servant APIs in any programming language +category: Servant, Web description: Helper types and functions for generating client functions for servant APIs in any programming language . @@ -9,25 +12,24 @@ See the servant-js package for an example . + +homepage: http://haskell-servant.readthedocs.org/ +bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3 license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com -copyright: 2015-2016 Servant Contributors -category: Servant, Web +copyright: 2015-2018 Servant Contributors build-type: Simple -cabal-version: >=1.10 +tested-with: + GHC ==8.0.2 + || ==8.2.2 + || ==8.4.4 + || ==8.6.2 + extra-source-files: - include/*.h CHANGELOG.md README.md -bug-reports: http://github.com/haskell-servant/servant/issues -tested-with: - GHC==7.8.4, - GHC==7.10.3, - GHC==8.0.2, - GHC==8.2.2, - GHC==8.4.1 source-repository head type: git @@ -43,36 +45,28 @@ -- -- note: mtl lower bound is so low because of GHC-7.8 build-depends: - base >= 4.7 && <4.12 + base >= 4.9 && < 4.13 , text >= 1.2.3.0 && < 1.3 - if !impl(ghc >= 8.0) - build-depends: - semigroups >=0.18.3 && <0.19 - -- Servant dependencies build-depends: - servant == 0.13.* + servant == 0.15.* -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. build-depends: - base-compat >= 0.9.3 && <0.10 - , lens >= 4.15.4 && <4.17 - , http-types >= 0.12 && < 0.13 + base-compat >= 0.10.5 && < 0.11 + , lens >= 4.17 && < 4.18 + , http-types >= 0.12.2 && < 0.13 hs-source-dirs: src default-language: Haskell2010 - ghc-options: -Wall - if impl(ghc >= 8.0) - ghc-options: -Wno-redundant-constraints - include-dirs: include + ghc-options: -Wall -Wno-redundant-constraints test-suite spec type: exitcode-stdio-1.0 hs-source-dirs: test ghc-options: -Wall - include-dirs: include main-is: Spec.hs other-modules: Servant.ForeignSpec @@ -84,8 +78,8 @@ -- Additonal dependencies build-depends: - hspec >= 2.4.4 && <2.6 + hspec >= 2.6.0 && <2.7 build-tool-depends: - hspec-discover:hspec-discover >=2.4.4 && <2.6 + hspec-discover:hspec-discover >=2.6.0 && <2.7 default-language: Haskell2010 diff --git a/src/Servant/Foreign.hs b/src/Servant/Foreign.hs --- a/src/Servant/Foreign.hs +++ b/src/Servant/Foreign.hs @@ -5,6 +5,7 @@ , HeaderArg(..) , QueryArg(..) , Req(..) + , ReqBodyContentType(..) , Segment(..) , SegmentType(..) , Url(..) @@ -21,6 +22,7 @@ , reqMethod , reqHeaders , reqBody + , reqBodyContentType , reqReturnType , reqFuncName , path @@ -51,6 +53,6 @@ , module Servant.Foreign.Inflections ) where -import Servant.API -import Servant.Foreign.Internal -import Servant.Foreign.Inflections +import Servant.API +import Servant.Foreign.Inflections +import Servant.Foreign.Internal diff --git a/src/Servant/Foreign/Inflections.hs b/src/Servant/Foreign/Inflections.hs --- a/src/Servant/Foreign/Inflections.hs +++ b/src/Servant/Foreign/Inflections.hs @@ -10,11 +10,14 @@ ) where -import Control.Lens hiding (cons) -import qualified Data.Char as C +import Control.Lens hiding + (cons) +import qualified Data.Char as C import Data.Monoid -import Data.Text hiding (map) -import Prelude hiding (head, tail) +import Data.Text hiding + (map) +import Prelude hiding + (head, tail) import Servant.Foreign.Internal concatCaseL :: Getter FunctionName Text diff --git a/src/Servant/Foreign/Internal.hs b/src/Servant/Foreign/Internal.hs --- a/src/Servant/Foreign/Internal.hs +++ b/src/Servant/Foreign/Internal.hs @@ -1,42 +1,44 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE UndecidableInstances #-} -#if !MIN_VERSION_base(4,8,0) -{-# LANGUAGE NullaryTypeClasses #-} -#endif +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE UndecidableInstances #-} -- | Generalizes all the data needed to make code generation work with -- arbitrary programming languages. module Servant.Foreign.Internal where -import Prelude () -import Prelude.Compat +import Prelude () +import Prelude.Compat -import Control.Lens (makePrisms, makeLenses, Getter, (&), (<>~), (%~), - (.~)) -import Data.Data (Data) +import Control.Lens + (Getter, makeLenses, makePrisms, (%~), (&), (.~), (<>~)) +import Data.Data + (Data) import Data.Proxy -import Data.Semigroup (Semigroup) +import Data.Semigroup + (Semigroup) import Data.String import Data.Text -import Data.Typeable (Typeable) -import Data.Text.Encoding (decodeUtf8) +import Data.Text.Encoding + (decodeUtf8) +import Data.Typeable + (Typeable) import GHC.TypeLits -import qualified Network.HTTP.Types as HTTP +import qualified Network.HTTP.Types as HTTP import Servant.API +import Servant.API.Modifiers + (RequiredArgument) import Servant.API.TypeLevel -import Servant.API.Modifiers (RequiredArgument) newtype FunctionName = FunctionName { unFunctionName :: [Text] } deriving (Data, Show, Eq, Semigroup, Monoid, Typeable) @@ -121,20 +123,24 @@ makeLenses ''Url +data ReqBodyContentType = ReqBodyJSON | ReqBodyMultipart + deriving (Data, Eq, Show, Read) + data Req f = Req - { _reqUrl :: Url f - , _reqMethod :: HTTP.Method - , _reqHeaders :: [HeaderArg f] - , _reqBody :: Maybe f - , _reqReturnType :: Maybe f - , _reqFuncName :: FunctionName + { _reqUrl :: Url f + , _reqMethod :: HTTP.Method + , _reqHeaders :: [HeaderArg f] + , _reqBody :: Maybe f + , _reqReturnType :: Maybe f + , _reqFuncName :: FunctionName + , _reqBodyContentType :: ReqBodyContentType } deriving (Data, Eq, Show, Typeable) makeLenses ''Req defReq :: Req ftype -defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) +defReq = Req defUrl "GET" [] Nothing Nothing (FunctionName []) ReqBodyJSON -- | 'HasForeignType' maps Haskell types with types in the target -- language of your backend. For example, let's say you're @@ -238,6 +244,20 @@ method = reflectMethod (Proxy :: Proxy method) methodLC = toLower $ decodeUtf8 method +-- | TODO: doesn't taking framing into account. +instance (ct ~ JSON, HasForeignType lang ftype a, ReflectMethod method) + => HasForeign lang ftype (Stream method status framing ct a) where + type Foreign ftype (Stream method status framing ct a) = Req ftype + + foreignFor lang Proxy Proxy req = + req & reqFuncName . _FunctionName %~ (methodLC :) + & reqMethod .~ method + & reqReturnType .~ Just retType + where + retType = typeFor lang (Proxy :: Proxy ftype) (Proxy :: Proxy a) + method = reflectMethod (Proxy :: Proxy method) + methodLC = toLower $ decodeUtf8 method + instance (KnownSymbol sym, HasForeignType lang ftype (RequiredArgument mods a), HasForeign lang ftype api) => HasForeign lang ftype (Header' mods sym a :> api) where type Foreign ftype (Header' mods sym a :> api) = Foreign ftype api @@ -305,6 +325,14 @@ foreignFor lang ftype Proxy req = foreignFor lang ftype (Proxy :: Proxy api) $ req & reqBody .~ (Just $ typeFor lang ftype (Proxy :: Proxy a)) + +instance + ( HasForeign lang ftype api + ) => HasForeign lang ftype (StreamBody' mods framing ctype a :> api) + where + type Foreign ftype (StreamBody' mods framing ctype a :> api) = Foreign ftype api + + foreignFor _lang Proxy Proxy _req = error "HasForeign @StreamBody" instance (KnownSymbol path, HasForeign lang ftype api) => HasForeign lang ftype (path :> api) where diff --git a/test/Servant/ForeignSpec.hs b/test/Servant/ForeignSpec.hs --- a/test/Servant/ForeignSpec.hs +++ b/test/Servant/ForeignSpec.hs @@ -1,27 +1,25 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE MultiParamTypeClasses #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -#if __GLASGOW_HASKELL__ < 709 -{-# OPTIONS_GHC -fcontext-stack=41 #-} -#endif -#include "overlapping-compat.h" +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} module Servant.ForeignSpec where -import Data.Monoid ((<>)) -import Data.Proxy -import Servant.Foreign -import Servant.API.Internal.Test.ComprehensiveAPI +import Data.Monoid + ((<>)) +import Data.Proxy +import Servant.Test.ComprehensiveAPI +import Servant.Foreign +import Servant.Types.SourceT + (SourceT) -import Test.Hspec +import Test.Hspec spec :: Spec @@ -55,13 +53,16 @@ instance HasForeignType LangX String Int where typeFor _ _ _ = "intX" +instance HasForeignType LangX String (SourceT m a) where + typeFor _ _ _ = "streamTX" + instance HasForeignType LangX String Bool where typeFor _ _ _ = "boolX" -instance OVERLAPPING_ HasForeignType LangX String String where +instance {-# OVERLAPPING #-} HasForeignType LangX String String where typeFor _ _ _ = "stringX" -instance OVERLAPPABLE_ HasForeignType LangX String a => HasForeignType LangX String [a] where +instance {-# OVERLAPPABLE #-} HasForeignType LangX String a => HasForeignType LangX String [a] where typeFor lang ftype _ = "listX of " <> typeFor lang ftype (Proxy :: Proxy a) instance (HasForeignType LangX String a) => HasForeignType LangX String (Maybe a) where