servant 0.7 → 0.7.1
raw patch · 9 files changed
+176/−38 lines, 9 filesdep +mmorphdep +mtldep ~base
Dependencies added: mmorph, mtl
Dependency ranges changed: base
Files
- CHANGELOG.md +41/−0
- servant.cabal +14/−8
- src/Servant/API/Header.hs +3/−3
- src/Servant/API/ResponseHeaders.hs +5/−11
- src/Servant/API/Vault.hs +2/−2
- src/Servant/Utils/Enter.hs +97/−0
- src/Servant/Utils/Links.hs +7/−8
- test/Servant/API/ContentTypesSpec.hs +2/−1
- test/Servant/Utils/LinksSpec.hs +5/−5
+ CHANGELOG.md view
@@ -0,0 +1,41 @@+0.7.1+-----++* Add module `Servant.Utils.Enter` (https://github.com/haskell-servant/servant/pull/478)+* Allow to set the same header multiple times in responses.++0.5+---++* Add `WithNamedConfig` combinator.+* Add `HttpVersion`, `IsSecure`, `RemoteHost` and `Vault` combinators+* Fix safeLink, so Header is not in fact required.+* Add more instances for (:<|>)+* Use `http-api-data` instead of `Servant.Common.Text`+* Remove matrix params.+* Add PlainText String MimeRender and MimeUnrender instances.+* Add new `Verbs` combinator, and make all existing and new verb combinators+type synonyms of it.+* Add `BasicAuth` combinator to support Basic authentication+* Add generalized authentication support++0.4.2+-----+* Fix missing cases for `Patch` in `safeLink`++0.4.1+-----+* Allow whitespace after parsing JSON+* Stricter matching for `safeLink` for `Capture`++0.4+---+* `Delete` now is like `Get`, `Post`, `Put`, and `Patch` and returns a response body+* Multiple content-type/accept support for all the relevant combinators+* Provide *JSON*, *PlainText*, *OctetStream* and *FormUrlEncoded* content types out of the box+* Type-safe link generation to API endpoints+* Support for the PATCH HTTP method+* Removed the home-made QuasiQuote for writing API types in a more human-friendly format until we come up with a better design for it+* Make most if not all of the haddock code examples run through doctest+* Some general code cleanup+* Add response headers
servant.cabal view
@@ -1,13 +1,13 @@ name: servant-version: 0.7+version: 0.7.1 synopsis: A family of combinators for defining webservices APIs description: A family of combinators for defining webservices APIs and serving them .- You can learn about the basics in the <http://haskell-servant.github.io/tutorial tutorial>.+ You can learn about the basics in the <http://haskell-servant.readthedocs.org/en/stable/tutorial/index.html tutorial>. . <https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md CHANGELOG>-homepage: http://haskell-servant.github.io/+homepage: http://haskell-servant.readthedocs.org/ Bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3 license-file: LICENSE@@ -16,9 +16,11 @@ copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors category: Web build-type: Simple-extra-source-files: include/*.h cabal-version: >=1.10 tested-with: GHC >= 7.8+extra-source-files:+ include/*.h+ CHANGELOG.md source-repository head type: git location: http://github.com/haskell-servant/servant.git@@ -45,8 +47,9 @@ Servant.API.Verbs Servant.API.WithNamedContext Servant.Utils.Links+ Servant.Utils.Enter build-depends:- base >= 4.7 && < 4.9+ base >= 4.7 && < 4.10 , base-compat >= 0.9 , aeson >= 0.7 , attoparsec >= 0.12@@ -56,6 +59,8 @@ , http-api-data >= 0.1 && < 0.3 , http-media >= 0.4 && < 0.7 , http-types >= 0.8 && < 0.10+ , mtl >= 2 && < 3+ , mmorph >= 1 , text >= 1 && < 2 , string-conversions >= 0.3 && < 0.5 , network-uri >= 2.6@@ -83,12 +88,13 @@ , TypeSynonymInstances , UndecidableInstances ghc-options: -Wall+ if impl(ghc >= 8.0)+ ghc-options: -Wno-redundant-constraints include-dirs: include test-suite spec type: exitcode-stdio-1.0- ghc-options:- -Wall -fno-warn-name-shadowing -fno-warn-missing-signatures+ ghc-options: -Wall default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs@@ -120,5 +126,5 @@ main-is: test/Doctests.hs buildable: True default-language: Haskell2010- ghc-options: -threaded+ ghc-options: -Wall -threaded include-dirs: include
src/Servant/API/Header.hs view
@@ -3,7 +3,9 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_HADDOCK not-home #-}-module Servant.API.Header where+module Servant.API.Header (+ Header(..),+) where import Data.ByteString (ByteString) import Data.Typeable (Typeable)@@ -25,5 +27,3 @@ -- >>> import Servant.API -- >>> import Data.Aeson -- >>> import Data.Text--- >>> data Book--- >>> instance ToJSON Book where { toJSON = undefined }
src/Servant/API/ResponseHeaders.hs view
@@ -68,8 +68,7 @@ instance OVERLAPPING_ BuildHeadersTo '[] where buildHeadersTo _ = HNil -instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h- , Contains h xs ~ 'False)+instance OVERLAPPABLE_ ( FromByteString v, BuildHeadersTo xs, KnownSymbol h ) => BuildHeadersTo ((Header h v) ': xs) where buildHeadersTo headers = let wantedHeader = CI.mk . pack $ symbolVal (Proxy :: Proxy h)@@ -89,7 +88,7 @@ instance OVERLAPPING_ GetHeaders (HList '[]) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs))+instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString x, GetHeaders (HList xs) ) => GetHeaders (HList (Header h x ': xs)) where getHeaders hdrs = case hdrs of Header val `HCons` rest -> (headerName , toByteString' val):getHeaders rest@@ -100,7 +99,7 @@ instance OVERLAPPING_ GetHeaders (Headers '[] a) where getHeaders _ = [] -instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v)+instance OVERLAPPABLE_ ( KnownSymbol h, GetHeaders (HList rest), ToByteString v ) => GetHeaders (Headers (Header h v ': rest) a) where getHeaders hs = getHeaders $ getHeadersHList hs @@ -112,19 +111,14 @@ addHeader :: v -> orig -> new -- ^ N.B.: The same header can't be added multiple times -instance OVERLAPPING_ ( KnownSymbol h, ToByteString v, Contains h (fst ': rest) ~ 'False)+instance OVERLAPPING_ ( KnownSymbol h, ToByteString v ) => AddHeader h v (Headers (fst ': rest) a) (Headers (Header h v ': fst ': rest) a) where addHeader a (Headers resp heads) = Headers resp (HCons (Header a) heads) instance OVERLAPPABLE_ ( KnownSymbol h, ToByteString v- , new ~ (Headers '[Header h v] a))+ , new ~ (Headers '[Header h v] a) ) => AddHeader h v a new where addHeader a resp = Headers resp (HCons (Header a) HNil)--type family Contains x xs where- Contains x ((Header x a) ': xs) = 'True- Contains x ((Header y a) ': xs) = Contains x xs- Contains x '[] = 'False -- $setup -- >>> import Servant.API
src/Servant/API/Vault.hs view
@@ -9,8 +9,8 @@ -- -- | Use 'Vault' in your API types to provide access to the 'Vault' -- of the request, which is a location shared by middlewares and applications--- to store arbitrary data. See 'Vault' for more details on how to actually--- use the vault in your handlers+-- to store arbitrary data. See <https://hackage.haskell.org/package/vault vault>+-- for more details on how to actually use the vault in your handlers -- -- Example: --
+ src/Servant/Utils/Enter.hs view
@@ -0,0 +1,97 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+module Servant.Utils.Enter where++import qualified Control.Category as C+#if MIN_VERSION_mtl(2,2,1)+import Control.Monad.Except+#endif+import Control.Monad.Identity+import Control.Monad.Morph+import Control.Monad.Reader+import qualified Control.Monad.State.Lazy as LState+import qualified Control.Monad.State.Strict as SState+import qualified Control.Monad.Writer.Lazy as LWriter+import qualified Control.Monad.Writer.Strict as SWriter+import Data.Typeable+import Prelude ()+import Prelude.Compat++import Servant.API++class Enter typ arg ret | typ arg -> ret, typ ret -> arg where+ enter :: arg -> typ -> ret++-- ** Servant combinators+instance ( Enter typ1 arg1 ret1, Enter typ2 arg2 ret2+ , arg1 ~ arg2+ ) => Enter (typ1 :<|> typ2) arg1 (ret1 :<|> ret2) where+ enter e (a :<|> b) = enter e a :<|> enter e b++instance (Enter b arg ret) => Enter (a -> b) arg (a -> ret) where+ enter arg f a = enter arg (f a)++-- ** Useful instances++-- | A natural transformation from @m@ to @n@. Used to `enter` particular+-- datatypes.+newtype m :~> n = Nat { unNat :: forall a. m a -> n a} deriving Typeable++instance C.Category (:~>) where+ id = Nat id+ Nat f . Nat g = Nat (f . g)++instance Enter (m a) (m :~> n) (n a) where+ enter (Nat f) = f++-- | Like `lift`.+liftNat :: (Control.Monad.Morph.MonadTrans t, Monad m) => m :~> t m+liftNat = Nat Control.Monad.Morph.lift++runReaderTNat :: r -> (ReaderT r m :~> m)+runReaderTNat a = Nat (`runReaderT` a)++evalStateTLNat :: Monad m => s -> (LState.StateT s m :~> m)+evalStateTLNat a = Nat (`LState.evalStateT` a)++evalStateTSNat :: Monad m => s -> (SState.StateT s m :~> m)+evalStateTSNat a = Nat (`SState.evalStateT` a)++-- | Log the contents of `SWriter.WriterT` with the function provided as the+-- first argument, and return the value of the @WriterT@ computation+logWriterTSNat :: MonadIO m => (w -> IO ()) -> (SWriter.WriterT w m :~> m)+logWriterTSNat logger = Nat $ \x -> do+ (a, w) <- SWriter.runWriterT x+ liftIO $ logger w+ return a++-- | Like `logWriterTSNat`, but for strict @WriterT@.+logWriterTLNat :: MonadIO m => (w -> IO ()) -> (LWriter.WriterT w m :~> m)+logWriterTLNat logger = Nat $ \x -> do+ (a, w) <- LWriter.runWriterT x+ liftIO $ logger w+ return a++-- | Like @mmorph@'s `hoist`.+hoistNat :: (MFunctor t, Monad m) => (m :~> n) -> (t m :~> t n)+hoistNat (Nat n) = Nat $ hoist n++-- | Like @mmorph@'s `embed`.+embedNat :: (MMonad t, Monad n) => (m :~> t n) -> (t m :~> t n)+embedNat (Nat n) = Nat $ embed n++-- | Like @mmorph@'s `squash`.+squashNat :: (Monad m, MMonad t) => t (t m) :~> t m+squashNat = Nat squash++-- | Like @mmorph@'s `generalize`.+generalizeNat :: Applicative m => Identity :~> m+generalizeNat = Nat (pure . runIdentity)
src/Servant/Utils/Links.hs view
@@ -72,14 +72,8 @@ -- >>> let bad_link = Proxy :: Proxy ("hello" :> Delete '[JSON] ()) -- >>> safeLink api bad_link -- ...--- Could not deduce (Or--- (IsElem' (Verb 'DELETE 200 '[JSON] ()) (Verb 'GET 200 '[JSON] Int))--- (IsElem'--- ("hello" :> Delete '[JSON] ())--- ("bye" :> (QueryParam "name" String :> Delete '[JSON] ()))))--- arising from a use of ‘safeLink’--- In the expression: safeLink api bad_link--- In an equation for ‘it’: it = safeLink api bad_link+-- ...Could not deduce...+-- ... -- -- This error is essentially saying that the type family couldn't find -- bad_link under api after trying the open (but empty) type family@@ -116,6 +110,7 @@ import Servant.API.ReqBody ( ReqBody ) import Servant.API.QueryParam ( QueryParam, QueryParams, QueryFlag ) import Servant.API.Header ( Header )+import Servant.API.RemoteHost ( RemoteHost ) import Servant.API.Verbs ( Verb ) import Servant.API.Sub ( type (:>) ) import Servant.API.Raw ( Raw )@@ -290,6 +285,10 @@ instance HasLink sub => HasLink (Header sym a :> sub) where type MkLink (Header sym a :> sub) = MkLink sub+ toLink _ = toLink (Proxy :: Proxy sub)++instance HasLink sub => HasLink (RemoteHost :> sub) where+ type MkLink (RemoteHost :> sub) = MkLink sub toLink _ = toLink (Proxy :: Proxy sub) -- Verb (terminal) instances
test/Servant/API/ContentTypesSpec.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-} {-# LANGUAGE PolyKinds #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Servant.API.ContentTypesSpec where@@ -28,7 +29,7 @@ import Network.URL (exportParams, importParams) import Test.Hspec import Test.QuickCheck-import Test.QuickCheck.Instances ()+import "quickcheck-instances" Test.QuickCheck.Instances () import Servant.API.ContentTypes
test/Servant/Utils/LinksSpec.hs view
@@ -67,27 +67,27 @@ -- -- >>> apiLink (Proxy :: Proxy WrongPath) -- ...--- Could not deduce ...+-- ...Could not deduce... -- ... -- -- >>> apiLink (Proxy :: Proxy WrongReturnType) -- ...--- Could not deduce ...+-- ...Could not deduce... -- ... -- -- >>> apiLink (Proxy :: Proxy WrongContentType) -- ...--- Could not deduce ...+-- ...Could not deduce... -- ... -- -- >>> apiLink (Proxy :: Proxy WrongMethod) -- ...--- Could not deduce ...+-- ...Could not deduce... -- ... -- -- >>> apiLink (Proxy :: Proxy NotALink) -- ...--- Could not deduce ...+-- ...Could not deduce... -- ... -- -- sanity check