git.iko.soy/typeable/servant
on master help sign in
7.10 CPP
7cb2ca0Julian K. Arni
servant-client/test/Servant/ClientSpec.hs+4−1
compare with master
unifiedsplit
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
@@ -10,7 +11,9 @@
10{-# OPTIONS_GHC -fno-warn-orphans #-}
11{-# OPTIONS_GHC -fno-warn-orphans #-}
11module Servant.ClientSpec where
12module Servant.ClientSpec where
12
13
14+#if !MIN_VERSION_base(4,8,0)
13−import Control.Applicative
15+import Control.Applicative ((<$>))
16+#endif
14import qualified Control.Arrow as Arrow
17import qualified Control.Arrow as Arrow
15import Control.Concurrent
18import Control.Concurrent
16import Control.Exception
19import Control.Exception
servant-server/src/Servant/Server/Internal.hs+18−12
@@ -10,16 +10,19 @@
10#if !MIN_VERSION_base(4,8,0)
10#if !MIN_VERSION_base(4,8,0)
11{-# LANGUAGE OverlappingInstances #-}
11{-# LANGUAGE OverlappingInstances #-}
12#endif
12#endif
13+
13module Servant.Server.Internal where
14module Servant.Server.Internal where
14
15
16+#if !MIN_VERSION_base(4,8,0)
15import Control.Applicative ((<$>))
17import Control.Applicative ((<$>))
18+import Data.Monoid (Monoid, mappend, mempty)
19+#endif
16import Control.Monad.Trans.Either (EitherT, runEitherT)
20import Control.Monad.Trans.Either (EitherT, runEitherT)
17import qualified Data.ByteString as B
21import qualified Data.ByteString as B
18import qualified Data.ByteString.Lazy as BL
22import qualified Data.ByteString.Lazy as BL
19import Data.IORef (newIORef, readIORef, writeIORef)
23import Data.IORef (newIORef, readIORef, writeIORef)
20import Data.List (unfoldr)
24import Data.List (unfoldr)
21import Data.Maybe (catMaybes, fromMaybe)
25import Data.Maybe (catMaybes, fromMaybe)
22−import Data.Monoid (Monoid, mappend, mempty)
23import Data.String (fromString)
26import Data.String (fromString)
24import Data.String.Conversions (cs, (<>))
27import Data.String.Conversions (cs, (<>))
25import Data.Text (Text)
28import Data.Text (Text)
@@ -281,7 +284,7 @@ instance HasServer Delete where
281-- If successfully returning a value, we use the type-level list, combined
284-- If successfully returning a value, we use the type-level list, combined
282-- with the request's @Accept@ header, to encode the value for you
285-- with the request's @Accept@ header, to encode the value for you
283-- (returning a status code of 200). If there was no @Accept@ header or it
286-- (returning a status code of 200). If there was no @Accept@ header or it
284−-- was @*/*@, we return encode using the first @Content-Type@ type on the
287+-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
285-- list.
288-- list.
286instance
289instance
287#if MIN_VERSION_base(4,8,0)
290#if MIN_VERSION_base(4,8,0)
@@ -296,7 +299,7 @@ instance
296 e <- runEitherT action
299 e <- runEitherT action
297 respond $ case e of
300 respond $ case e of
298 Right output -> do
301 Right output -> do
299− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
302+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
300 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
303 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
301 Nothing -> failWith UnsupportedMediaType
304 Nothing -> failWith UnsupportedMediaType
302 Just (contentT, body) -> succeedWith $
305 Just (contentT, body) -> succeedWith $
@@ -341,7 +344,7 @@ instance
341 e <- runEitherT action
344 e <- runEitherT action
342 respond $ case e of
345 respond $ case e of
343 Right output -> do
346 Right output -> do
344− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
347+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
345 headers = getHeaders output
348 headers = getHeaders output
346 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
349 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
347 Nothing -> failWith UnsupportedMediaType
350 Nothing -> failWith UnsupportedMediaType
@@ -396,7 +399,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
396-- If successfully returning a value, we use the type-level list, combined
399-- If successfully returning a value, we use the type-level list, combined
397-- with the request's @Accept@ header, to encode the value for you
400-- with the request's @Accept@ header, to encode the value for you
398-- (returning a status code of 201). If there was no @Accept@ header or it
401-- (returning a status code of 201). If there was no @Accept@ header or it
399−-- was @*/*@, we return encode using the first @Content-Type@ type on the
402+-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
400-- list.
403-- list.
401instance
404instance
402#if MIN_VERSION_base(4,8,0)
405#if MIN_VERSION_base(4,8,0)
@@ -412,7 +415,7 @@ instance
412 e <- runEitherT action
415 e <- runEitherT action
413 respond $ case e of
416 respond $ case e of
414 Right output -> do
417 Right output -> do
415− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
418+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
416 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
419 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
417 Nothing -> failWith UnsupportedMediaType
420 Nothing -> failWith UnsupportedMediaType
418 Just (contentT, body) -> succeedWith $
421 Just (contentT, body) -> succeedWith $
@@ -456,7 +459,7 @@ instance
456 e <- runEitherT action
459 e <- runEitherT action
457 respond $ case e of
460 respond $ case e of
458 Right output -> do
461 Right output -> do
459− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
462+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
460 headers = getHeaders output
463 headers = getHeaders output
461 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
464 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
462 Nothing -> failWith UnsupportedMediaType
465 Nothing -> failWith UnsupportedMediaType
@@ -479,7 +482,7 @@ instance
479-- If successfully returning a value, we use the type-level list, combined
482-- If successfully returning a value, we use the type-level list, combined
480-- with the request's @Accept@ header, to encode the value for you
483-- with the request's @Accept@ header, to encode the value for you
481-- (returning a status code of 200). If there was no @Accept@ header or it
484-- (returning a status code of 200). If there was no @Accept@ header or it
482−-- was @*/*@, we return encode using the first @Content-Type@ type on the
485+-- was @*\/\*@, we return encode using the first @Content-Type@ type on the
483-- list.
486-- list.
484instance
487instance
485#if MIN_VERSION_base(4,8,0)
488#if MIN_VERSION_base(4,8,0)
@@ -494,7 +497,7 @@ instance
494 e <- runEitherT action
497 e <- runEitherT action
495 respond $ case e of
498 respond $ case e of
496 Right output -> do
499 Right output -> do
497− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
500+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
498 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
501 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
499 Nothing -> failWith UnsupportedMediaType
502 Nothing -> failWith UnsupportedMediaType
500 Just (contentT, body) -> succeedWith $
503 Just (contentT, body) -> succeedWith $
@@ -538,7 +541,7 @@ instance
538 e <- runEitherT action
541 e <- runEitherT action
539 respond $ case e of
542 respond $ case e of
540 Right output -> do
543 Right output -> do
541− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
544+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
542 headers = getHeaders output
545 headers = getHeaders output
543 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
546 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
544 Nothing -> failWith UnsupportedMediaType
547 Nothing -> failWith UnsupportedMediaType
@@ -574,7 +577,7 @@ instance
574 e <- runEitherT action
577 e <- runEitherT action
575 respond $ case e of
578 respond $ case e of
576 Right output -> do
579 Right output -> do
577− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
580+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
578 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
581 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
579 Nothing -> failWith UnsupportedMediaType
582 Nothing -> failWith UnsupportedMediaType
580 Just (contentT, body) -> succeedWith $
583 Just (contentT, body) -> succeedWith $
@@ -618,7 +621,7 @@ instance
618 e <- runEitherT action
621 e <- runEitherT action
619 respond $ case e of
622 respond $ case e of
620 Right outpatch -> do
623 Right outpatch -> do
621− let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request
624+ let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
622 headers = getHeaders outpatch
625 headers = getHeaders outpatch
623 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
626 case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
624 Nothing -> failWith UnsupportedMediaType
627 Nothing -> failWith UnsupportedMediaType
@@ -929,3 +932,6 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
929 _ -> respond $ failWith NotFound
932 _ -> respond $ failWith NotFound
930
933
931 where proxyPath = Proxy :: Proxy path
934 where proxyPath = Proxy :: Proxy path
935+
936+ct_wildcard :: B.ByteString
937+ct_wildcard = "*" <> "/" <> "*" -- Because CPP