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 DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
@ -10,7 +11,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
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 Control.Concurrent
import Control.Exception

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

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