eeva/servant
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

7.10 CPP

Browse Source 
Including some annoying hacks to work around CPP comments.
This commit is contained in:
Julian K. Arni 2015-04-22 14:57:30 +02:00
parent f82ca76f7d
commit 7cb2ca05c4
2 changed files with 22 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
servant-client/test/Servant/ClientSpec.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
@ -10,7 +11,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
module Servant.ClientSpec where module Servant.ClientSpec where
import Control.Applicative #if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import qualified Control.Arrow as Arrow import qualified Control.Arrow as Arrow
import Control.Concurrent import Control.Concurrent
import Control.Exception import Control.Exception

30
servant-server/src/Servant/Server/Internal.hs
View File

@ -10,16 +10,19 @@
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
{-# LANGUAGE OverlappingInstances #-} {-# LANGUAGE OverlappingInstances #-}
#endif #endif
module Servant.Server.Internal where module Servant.Server.Internal where
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import Data.Monoid (Monoid, mappend, mempty)
#endif
import Control.Monad.Trans.Either (EitherT, runEitherT) import Control.Monad.Trans.Either (EitherT, runEitherT)
import qualified Data.ByteString as B import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import Data.IORef (newIORef, readIORef, writeIORef) import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (unfoldr) import Data.List (unfoldr)
import Data.Maybe (catMaybes, fromMaybe) import Data.Maybe (catMaybes, fromMaybe)
import Data.Monoid (Monoid, mappend, mempty)
import Data.String (fromString) import Data.String (fromString)
import Data.String.Conversions (cs, (<>)) import Data.String.Conversions (cs, (<>))
import Data.Text (Text) import Data.Text (Text)
@ -281,7 +284,7 @@ instance HasServer Delete where
-- If successfully returning a value, we use the type-level list, combined -- If successfully returning a value, we use the type-level list, combined
-- with the request's @Accept@ header, to encode the value for you -- with the request's @Accept@ header, to encode the value for you
-- (returning a status code of 200). If there was no @Accept@ header or it -- (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 -- was @*\/\*@, we return encode using the first @Content-Type@ type on the
-- list. -- list.
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
@ -296,7 +299,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -341,7 +344,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders output headers = getHeaders output
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -396,7 +399,7 @@ instance (KnownSymbol sym, FromText a, HasServer sublayout)
-- If successfully returning a value, we use the type-level list, combined -- If successfully returning a value, we use the type-level list, combined
-- with the request's @Accept@ header, to encode the value for you -- with the request's @Accept@ header, to encode the value for you
-- (returning a status code of 201). If there was no @Accept@ header or it -- (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 -- was @*\/\*@, we return encode using the first @Content-Type@ type on the
-- list. -- list.
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
@ -412,7 +415,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -456,7 +459,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders output headers = getHeaders output
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -479,7 +482,7 @@ instance
-- If successfully returning a value, we use the type-level list, combined -- If successfully returning a value, we use the type-level list, combined
-- with the request's @Accept@ header, to encode the value for you -- with the request's @Accept@ header, to encode the value for you
-- (returning a status code of 200). If there was no @Accept@ header or it -- (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 -- was @*\/\*@, we return encode using the first @Content-Type@ type on the
-- list. -- list.
instance instance
#if MIN_VERSION_base(4,8,0) #if MIN_VERSION_base(4,8,0)
@ -494,7 +497,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -538,7 +541,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders output headers = getHeaders output
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse output) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -574,7 +577,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right output -> do Right output -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) output of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
Just (contentT, body) -> succeedWith $ Just (contentT, body) -> succeedWith $
@ -618,7 +621,7 @@ instance
e <- runEitherT action e <- runEitherT action
respond $ case e of respond $ case e of
Right outpatch -> do Right outpatch -> do
let accH = fromMaybe "*/*" $ lookup hAccept $ requestHeaders request let accH = fromMaybe ct_wildcard $ lookup hAccept $ requestHeaders request
headers = getHeaders outpatch headers = getHeaders outpatch
case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of case handleAcceptH (Proxy :: Proxy ctypes) (AcceptHeader accH) (getResponse outpatch) of
Nothing -> failWith UnsupportedMediaType Nothing -> failWith UnsupportedMediaType
@ -929,3 +932,6 @@ instance (KnownSymbol path, HasServer sublayout) => HasServer (path :> sublayout
_ -> respond $ failWith NotFound _ -> respond $ failWith NotFound
where proxyPath = Proxy :: Proxy path where proxyPath = Proxy :: Proxy path
ct_wildcard :: B.ByteString
ct_wildcard = "*" <> "/" <> "*" -- Because CPP