7.10 changes
This commit is contained in:
parent
f4edddc770
commit
f82ca76f7d
18 changed files with 251 additions and 88 deletions
16
.travis.yml
16
.travis.yml
|
@ -1,11 +1,19 @@
|
|||
language: haskell
|
||||
|
||||
ghc:
|
||||
- 7.8
|
||||
env:
|
||||
- CABALVER=1.18 GHCVER=7.8.4
|
||||
- CABALVER=1.22 GHCVER=7.10.1
|
||||
|
||||
before_install:
|
||||
- travis_retry sudo add-apt-repository -y ppa:hvr/ghc
|
||||
- travis_retry sudo apt-get update
|
||||
- travis_retry sudo apt-get install cabal-install-$CABALVER ghc-$GHCVER
|
||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
||||
- travis_retry cabal update
|
||||
|
||||
install:
|
||||
- ghc --version
|
||||
- cabal --version
|
||||
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- cabal --version
|
||||
|
||||
script:
|
||||
- ./scripts/test-all.sh
|
||||
|
|
|
@ -2,12 +2,17 @@
|
|||
# Also a good way of running the tests for all packages
|
||||
with (import <nixpkgs> {}).pkgs;
|
||||
let modifiedHaskellPackages = haskellngPackages.override {
|
||||
overrides = self: super: {
|
||||
servant = self.callPackage ../servant {};
|
||||
servant-server = self.callPackage ../servant-server {};
|
||||
servant-client = self.callPackage ../servant-client {};
|
||||
servant-jquery = self.callPackage ../servant-jquery {};
|
||||
servant-docs = self.callPackage ../servant-docs {};
|
||||
overrides = with haskell-ng.lib ; self: super: {
|
||||
servant = appendConfigureFlag ( self.callPackage ../servant {} )
|
||||
"--ghc-options=-Werror";
|
||||
servant-server = appendConfigureFlag (self.callPackage
|
||||
../servant-server {}) "--ghc-options=-Werror";
|
||||
servant-client = appendConfigureFlag (self.callPackage
|
||||
../servant-client {}) "--ghc-options=-Werror";
|
||||
servant-jquery = appendConfigureFlag (self.callPackage
|
||||
../servant-jquery {}) "--ghc-options=-Werror";
|
||||
servant-docs = appendConfigureFlag (self.callPackage ../servant-docs
|
||||
{}) "--ghc-options=-Werror";
|
||||
};
|
||||
};
|
||||
in modifiedHaskellPackages.ghcWithPackages ( p : with p ; [
|
||||
|
|
|
@ -17,15 +17,16 @@ set -o errexit
|
|||
DIR=$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )
|
||||
GHC_FLAGS="-Werror"
|
||||
SOURCES_TXT="$( dirname $DIR)/sources.txt"
|
||||
CABAL=${CABAL:-cabal}
|
||||
|
||||
declare -a SOURCES
|
||||
readarray -t SOURCES < "$SOURCES_TXT"
|
||||
|
||||
|
||||
prepare_sandbox () {
|
||||
cabal sandbox init
|
||||
$CABAL sandbox init
|
||||
for s in ${SOURCES[@]} ; do
|
||||
(cd "$s" && cabal sandbox init --sandbox=../ && cabal sandbox add-source .)
|
||||
(cd "$s" && $CABAL sandbox init --sandbox=../ && $CABAL sandbox add-source .)
|
||||
done
|
||||
}
|
||||
|
||||
|
@ -33,10 +34,10 @@ test_each () {
|
|||
for s in ${SOURCES[@]} ; do
|
||||
echo "Testing $s..."
|
||||
cd "$s"
|
||||
cabal install --only-dependencies --enable-tests
|
||||
cabal configure --enable-tests --ghc-options="$GHC_FLAGS"
|
||||
cabal build
|
||||
cabal test
|
||||
$CABAL install --only-dependencies --enable-tests
|
||||
$CABAL configure --enable-tests --ghc-options="$GHC_FLAGS"
|
||||
$CABAL build
|
||||
$CABAL test
|
||||
cd ..
|
||||
done
|
||||
}
|
||||
|
|
|
@ -1,12 +1,15 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE InstanceSigs #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
#endif
|
||||
-- | This module provides 'client' which can automatically generate
|
||||
-- querying functions for each endpoint just from the type representing your
|
||||
-- API.
|
||||
|
@ -18,21 +21,21 @@ module Servant.Client
|
|||
, module Servant.Common.BaseUrl
|
||||
) where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans.Either
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.List
|
||||
import Data.Proxy
|
||||
import Data.String.Conversions
|
||||
import Data.Text (unpack)
|
||||
import GHC.TypeLits
|
||||
import Network.HTTP.Client (Response)
|
||||
import Network.HTTP.Media
|
||||
import qualified Network.HTTP.Types as H
|
||||
import Servant.API
|
||||
import Servant.API.ContentTypes
|
||||
import Servant.Common.BaseUrl
|
||||
import Servant.Common.Req
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans.Either
|
||||
import Data.ByteString.Lazy (ByteString)
|
||||
import Data.List
|
||||
import Data.Proxy
|
||||
import Data.String.Conversions
|
||||
import Data.Text (unpack)
|
||||
import GHC.TypeLits
|
||||
import Network.HTTP.Client (Response)
|
||||
import Network.HTTP.Media
|
||||
import qualified Network.HTTP.Types as H
|
||||
import Servant.API
|
||||
import Servant.API.ContentTypes
|
||||
import Servant.Common.BaseUrl
|
||||
import Servant.Common.Req
|
||||
|
||||
-- * Accessing APIs as a Client
|
||||
|
||||
|
@ -123,14 +126,22 @@ instance HasClient Delete where
|
|||
-- side querying function that is created when calling 'client'
|
||||
-- will just require an argument that specifies the scheme, host
|
||||
-- and port to send the request to.
|
||||
instance (MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
(MimeUnrender ct result) => HasClient (Get (ct ': cts) result) where
|
||||
type Client' (Get (ct ': cts) result) = BaseUrl -> EitherT ServantError IO result
|
||||
clientWithRoute Proxy req host =
|
||||
performRequestCT (Proxy :: Proxy ct) H.methodGet req [200, 203] host
|
||||
|
||||
-- | If you have a 'Get xs ()' endpoint, the client expects a 204 No Content
|
||||
-- HTTP header.
|
||||
instance HasClient (Get (ct ': cts) ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasClient (Get (ct ': cts) ()) where
|
||||
type Client' (Get (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
|
||||
clientWithRoute Proxy req host =
|
||||
performRequestNoBody H.methodGet req [204] host
|
||||
|
@ -176,7 +187,11 @@ instance (KnownSymbol sym, ToText a, HasClient sublayout)
|
|||
-- side querying function that is created when calling 'client'
|
||||
-- will just require an argument that specifies the scheme, host
|
||||
-- and port to send the request to.
|
||||
instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
(MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
|
||||
type Client' (Post (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
|
||||
|
||||
clientWithRoute Proxy req uri =
|
||||
|
@ -184,7 +199,11 @@ instance (MimeUnrender ct a) => HasClient (Post (ct ': cts) a) where
|
|||
|
||||
-- | If you have a 'Post xs ()' endpoint, the client expects a 204 No Content
|
||||
-- HTTP header.
|
||||
instance HasClient (Post (ct ': cts) ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasClient (Post (ct ': cts) ()) where
|
||||
type Client' (Post (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
|
||||
clientWithRoute Proxy req host =
|
||||
void $ performRequestNoBody H.methodPost req [204] host
|
||||
|
@ -193,7 +212,11 @@ instance HasClient (Post (ct ': cts) ()) where
|
|||
-- side querying function that is created when calling 'client'
|
||||
-- will just require an argument that specifies the scheme, host
|
||||
-- and port to send the request to.
|
||||
instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
(MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
|
||||
type Client' (Put (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
|
||||
|
||||
clientWithRoute Proxy req host =
|
||||
|
@ -201,7 +224,11 @@ instance (MimeUnrender ct a) => HasClient (Put (ct ': cts) a) where
|
|||
|
||||
-- | If you have a 'Put xs ()' endpoint, the client expects a 204 No Content
|
||||
-- HTTP header.
|
||||
instance HasClient (Put (ct ': cts) ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasClient (Put (ct ': cts) ()) where
|
||||
type Client' (Put (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
|
||||
clientWithRoute Proxy req host =
|
||||
void $ performRequestNoBody H.methodPut req [204] host
|
||||
|
@ -210,7 +237,11 @@ instance HasClient (Put (ct ': cts) ()) where
|
|||
-- side querying function that is created when calling 'client'
|
||||
-- will just require an argument that specifies the scheme, host
|
||||
-- and port to send the request to.
|
||||
instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
(MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
|
||||
type Client' (Patch (ct ': cts) a) = BaseUrl -> EitherT ServantError IO a
|
||||
|
||||
clientWithRoute Proxy req host =
|
||||
|
@ -218,7 +249,11 @@ instance (MimeUnrender ct a) => HasClient (Patch (ct ': cts) a) where
|
|||
|
||||
-- | If you have a 'Patch xs ()' endpoint, the client expects a 204 No Content
|
||||
-- HTTP header.
|
||||
instance HasClient (Patch (ct ': cts) ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasClient (Patch (ct ': cts) ()) where
|
||||
type Client' (Patch (ct ': cts) ()) = BaseUrl -> EitherT ServantError IO ()
|
||||
clientWithRoute Proxy req host =
|
||||
void $ performRequestNoBody H.methodPatch req [204] host
|
||||
|
|
|
@ -1,8 +1,11 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Servant.Common.Req where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Exception
|
||||
import Control.Monad
|
||||
import Control.Monad.Catch (MonadThrow)
|
||||
|
|
|
@ -340,6 +340,6 @@ pathGen :: Gen (NonEmptyList Char)
|
|||
pathGen = fmap NonEmpty path
|
||||
where
|
||||
path = listOf1 $ elements $
|
||||
filter (not . (`elem` "?%[]/#;")) $
|
||||
filter (not . (`elem` ("?%[]/#;" :: String))) $
|
||||
filter isPrint $
|
||||
map chr [0..127]
|
||||
|
|
|
@ -1,7 +1,10 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Servant.Common.BaseUrlSpec where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.DeepSeq
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
|
@ -13,7 +14,9 @@
|
|||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Servant.Docs.Internal where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Lens
|
||||
import Data.ByteString.Lazy.Char8 (ByteString)
|
||||
import Data.Hashable
|
||||
|
|
|
@ -1,15 +1,18 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
module Servant.JQuery.Internal where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Lens
|
||||
import Data.Char (toLower)
|
||||
import qualified Data.CharSet as Set
|
||||
|
|
|
@ -1,12 +1,15 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
#endif
|
||||
module Servant.Server.Internal where
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
|
@ -280,8 +283,11 @@ instance HasServer Delete where
|
|||
-- (returning a status code of 200). If there was no @Accept@ header or it
|
||||
-- was @*/*@, we return encode using the first @Content-Type@ type on the
|
||||
-- list.
|
||||
instance ( AllCTRender ctypes a
|
||||
) => HasServer (Get ctypes a) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
( AllCTRender ctypes a ) => HasServer (Get ctypes a) where
|
||||
|
||||
type ServerT' (Get ctypes a) m = m a
|
||||
|
||||
|
@ -302,8 +308,14 @@ instance ( AllCTRender ctypes a
|
|||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
-- '()' ==> 204 No Content
|
||||
instance HasServer (Get ctypes ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasServer (Get ctypes ()) where
|
||||
|
||||
type ServerT' (Get ctypes ()) m = m ()
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodGet = do
|
||||
e <- runEitherT action
|
||||
|
@ -316,8 +328,14 @@ instance HasServer (Get ctypes ()) where
|
|||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
-- Add response headers
|
||||
instance ( AllCTRender ctypes v ) => HasServer (Get ctypes (Headers h v)) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
( AllCTRender ctypes v ) => HasServer (Get ctypes (Headers h v)) where
|
||||
|
||||
type ServerT' (Get ctypes (Headers h v)) m = m (Headers h v)
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodGet = do
|
||||
e <- runEitherT action
|
||||
|
@ -380,7 +398,11 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
|
|||
-- (returning a status code of 201). If there was no @Accept@ header or it
|
||||
-- was @*/*@, we return encode using the first @Content-Type@ type on the
|
||||
-- list.
|
||||
instance ( AllCTRender ctypes a
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
( AllCTRender ctypes a
|
||||
) => HasServer (Post ctypes a) where
|
||||
|
||||
type ServerT' (Post ctypes a) m = m a
|
||||
|
@ -401,8 +423,14 @@ instance ( AllCTRender ctypes a
|
|||
respond $ failWith WrongMethod
|
||||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
instance HasServer (Post ctypes ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasServer (Post ctypes ()) where
|
||||
|
||||
type ServerT' (Post ctypes ()) m = m ()
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodPost = do
|
||||
e <- runEitherT action
|
||||
|
@ -415,8 +443,14 @@ instance HasServer (Post ctypes ()) where
|
|||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
-- Add response headers
|
||||
instance ( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
|
||||
|
||||
type ServerT' (Post ctypes (Headers h v)) m = m (Headers h v)
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodPost = do
|
||||
e <- runEitherT action
|
||||
|
@ -447,8 +481,11 @@ instance ( AllCTRender ctypes v ) => HasServer (Post ctypes (Headers h v)) where
|
|||
-- (returning a status code of 200). If there was no @Accept@ header or it
|
||||
-- was @*/*@, we return encode using the first @Content-Type@ type on the
|
||||
-- list.
|
||||
instance ( AllCTRender ctypes a
|
||||
) => HasServer (Put ctypes a) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
( AllCTRender ctypes a) => HasServer (Put ctypes a) where
|
||||
|
||||
type ServerT' (Put ctypes a) m = m a
|
||||
|
||||
|
@ -468,8 +505,14 @@ instance ( AllCTRender ctypes a
|
|||
respond $ failWith WrongMethod
|
||||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
instance HasServer (Put ctypes ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasServer (Put ctypes ()) where
|
||||
|
||||
type ServerT' (Put ctypes ()) m = m ()
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodPut = do
|
||||
e <- runEitherT action
|
||||
|
@ -482,8 +525,14 @@ instance HasServer (Put ctypes ()) where
|
|||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
-- Add response headers
|
||||
instance ( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
|
||||
|
||||
type ServerT' (Put ctypes (Headers h v)) m = m (Headers h v)
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodPut = do
|
||||
e <- runEitherT action
|
||||
|
@ -512,8 +561,12 @@ instance ( AllCTRender ctypes v ) => HasServer (Put ctypes (Headers h v)) where
|
|||
-- If successfully returning a value, we just require that its type has
|
||||
-- a 'ToJSON' instance and servant takes care of encoding it for you,
|
||||
-- yielding status code 200 along the way.
|
||||
instance ( AllCTRender ctypes a
|
||||
) => HasServer (Patch ctypes a) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
( AllCTRender ctypes a) => HasServer (Patch ctypes a) where
|
||||
|
||||
type ServerT' (Patch ctypes a) m = m a
|
||||
|
||||
route Proxy action request respond
|
||||
|
@ -532,8 +585,14 @@ instance ( AllCTRender ctypes a
|
|||
respond $ failWith WrongMethod
|
||||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
instance HasServer (Patch ctypes ()) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
HasServer (Patch ctypes ()) where
|
||||
|
||||
type ServerT' (Patch ctypes ()) m = m ()
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodPatch = do
|
||||
e <- runEitherT action
|
||||
|
@ -546,8 +605,14 @@ instance HasServer (Patch ctypes ()) where
|
|||
| otherwise = respond $ failWith NotFound
|
||||
|
||||
-- Add response headers
|
||||
instance ( AllCTRender ctypes v ) => HasServer (Patch ctypes (Headers h v)) where
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
( AllCTRender ctypes v ) => HasServer (Patch ctypes (Headers h v)) where
|
||||
|
||||
type ServerT' (Patch ctypes (Headers h v)) m = m (Headers h v)
|
||||
|
||||
route Proxy action request respond
|
||||
| pathIsEmpty request && requestMethod request == methodPatch = do
|
||||
e <- runEitherT action
|
||||
|
|
|
@ -59,7 +59,8 @@ library
|
|||
, network-uri >= 2.6
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
other-extensions: ConstraintKinds
|
||||
other-extensions: CPP
|
||||
, ConstraintKinds
|
||||
, DataKinds
|
||||
, DeriveDataTypeable
|
||||
, FlexibleInstances
|
||||
|
|
|
@ -1,8 +1,11 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
module Servant.API.Alternative ((:<|>)(..)) where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Data.Monoid (Monoid (..))
|
||||
#endif
|
||||
import Data.Typeable (Typeable)
|
||||
-- | Union of two APIs, first takes precedence in case of overlap.
|
||||
--
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
@ -63,7 +64,9 @@ module Servant.API.ContentTypes
|
|||
, eitherDecodeLenient
|
||||
) where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<*))
|
||||
#endif
|
||||
import Control.Arrow (left)
|
||||
import Control.Monad
|
||||
import Data.Aeson (FromJSON, ToJSON, Value,
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
|
@ -6,11 +7,13 @@
|
|||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE KindSignatures #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
{-# LANGUAGE OverlappingInstances #-}
|
||||
#endif
|
||||
|
||||
-- | This module provides facilities for adding headers to a response.
|
||||
--
|
||||
|
@ -50,13 +53,21 @@ class AddHeader h v orig new
|
|||
| h v orig -> new, new -> h, new -> v, new -> orig where
|
||||
addHeader :: v -> orig -> new
|
||||
|
||||
instance ( KnownSymbol h, ToByteString v
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPING #-}
|
||||
#endif
|
||||
( 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 ((headerName, toByteString' a) : heads)
|
||||
where
|
||||
headerName = CI.mk . pack $ symbolVal (Proxy :: Proxy h)
|
||||
|
||||
instance ( KnownSymbol h, ToByteString v
|
||||
instance
|
||||
#if MIN_VERSION_base(4,8,0)
|
||||
{-# OVERLAPPABLE #-}
|
||||
#endif
|
||||
( KnownSymbol h, ToByteString v
|
||||
, new ~ (Headers '[Header h v] a)
|
||||
) => AddHeader h v a new where
|
||||
addHeader a resp = Headers resp [(headerName, toByteString' a)]
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
|
@ -6,12 +7,18 @@ module Servant.Common.Text
|
|||
, ToText(..)
|
||||
) where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative ((<$>))
|
||||
#endif
|
||||
import Data.Int (Int16, Int32, Int64, Int8)
|
||||
import Data.String.Conversions (cs)
|
||||
import Data.Text (Text)
|
||||
import Data.Text.Read (Reader, decimal, rational, signed)
|
||||
import Data.Word (Word, Word16, Word32, Word64, Word8)
|
||||
import Data.Word (Word16, Word32, Word64, Word8
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
, Word
|
||||
#endif
|
||||
)
|
||||
|
||||
-- | For getting values from url captures and query string parameters
|
||||
-- Instances should obey:
|
||||
|
|
|
@ -1,13 +1,13 @@
|
|||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE ConstraintKinds #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE FunctionalDependencies #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
-- | Type safe generation of internal links.
|
||||
--
|
||||
|
@ -104,7 +104,11 @@ module Servant.Utils.Links (
|
|||
import Data.List
|
||||
import Data.Proxy ( Proxy(..) )
|
||||
import Data.Text (Text, unpack)
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Data.Monoid ( Monoid(..), (<>) )
|
||||
#else
|
||||
import Data.Monoid ( (<>) )
|
||||
#endif
|
||||
import Network.URI ( URI(..), escapeURIString, isUnreserved )
|
||||
import GHC.TypeLits ( KnownSymbol, symbolVal )
|
||||
import GHC.Exts(Constraint)
|
||||
|
|
|
@ -1,3 +1,4 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
@ -5,7 +6,9 @@
|
|||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
module Servant.API.ContentTypesSpec where
|
||||
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
import Control.Applicative
|
||||
#endif
|
||||
import Control.Arrow
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Parser (jstring)
|
||||
|
|
|
@ -1,8 +1,13 @@
|
|||
{-# LANGUAGE CPP #-}
|
||||
module Servant.Common.TextSpec where
|
||||
|
||||
import Data.Int (Int16, Int32, Int64, Int8)
|
||||
import Data.Text (Text)
|
||||
import Data.Word (Word, Word16, Word32, Word64, Word8)
|
||||
import Data.Word (Word16, Word32, Word64, Word8
|
||||
#if !MIN_VERSION_base(4,8,0)
|
||||
, Word
|
||||
#endif
|
||||
)
|
||||
import Servant.Common.Text
|
||||
import Test.Hspec
|
||||
import Test.QuickCheck
|
||||
|
|
Loading…
Reference in a new issue