From da0e1ca87133a916760f7414206969bbaea36ecf Mon Sep 17 00:00:00 2001
From: Timo von Holtz <tvh@anchor.com.au>
Date: Wed, 25 Feb 2015 09:56:06 +1100
Subject: [PATCH] Extend tests and clean up

---
 servant-client.cabal       |  1 +
 src/Servant/Common/Req.hs  |  4 ----
 test/Servant/ClientSpec.hs | 34 ++++++++++++++++++++++------------
 3 files changed, 23 insertions(+), 16 deletions(-)

diff --git a/servant-client.cabal b/servant-client.cabal
index a5576cbc..77b832b7 100644
--- a/servant-client.cabal
+++ b/servant-client.cabal
@@ -78,5 +78,6 @@ test-suite spec
     , servant >= 0.2.1
     , servant-client
     , servant-server >= 0.2.1
+    , text
     , wai
     , warp
diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs
index 77e077a7..446bfd12 100644
--- a/src/Servant/Common/Req.hs
+++ b/src/Servant/Common/Req.hs
@@ -9,10 +9,6 @@ import Control.Monad
 import Control.Monad.Catch (MonadThrow)
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Either
-import Data.Aeson
-import Data.Aeson.Parser
-import Data.Aeson.Types
-import Data.Attoparsec.ByteString
 import Data.ByteString.Lazy hiding (pack, filter, map, null)
 import Data.String
 import Data.String.Conversions
diff --git a/test/Servant/ClientSpec.hs b/test/Servant/ClientSpec.hs
index 40265dd0..063c6345 100644
--- a/test/Servant/ClientSpec.hs
+++ b/test/Servant/ClientSpec.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fcontext-stack=25 #-}
 module Servant.ClientSpec where
@@ -14,8 +15,9 @@ import Data.Aeson
 import Data.ByteString.Lazy (ByteString)
 import Data.Char
 import Data.Foldable (forM_)
+import Data.Monoid
 import Data.Proxy
-import Data.Typeable
+import qualified Data.Text as T
 import GHC.Generics
 import Network.HTTP.Media
 import Network.HTTP.Types
@@ -27,6 +29,7 @@ import Test.Hspec.QuickCheck
 import Test.QuickCheck
 
 import Servant.API
+import Servant.API.ContentTypes
 import Servant.Client
 import Servant.Server
 
@@ -41,22 +44,35 @@ data Person = Person {
 instance ToJSON Person
 instance FromJSON Person
 
+instance ToFormUrlEncoded Person where
+    toFormUrlEncoded Person{..} =
+        [("name", T.pack name), ("age", T.pack (show age))]
+
+lookupEither :: (Show a, Eq a) => a -> [(a,b)] -> Either String b
+lookupEither x xs = do
+    maybe (Left $ "could not find key " <> show x) return $ lookup x xs
+
+instance FromFormUrlEncoded Person where
+    fromFormUrlEncoded xs = do
+        n <- lookupEither "name" xs
+        a <- lookupEither "age" xs
+        return $ Person (T.unpack n) (read $ T.unpack a)
+
+
 alice :: Person
 alice = Person "Alice" 42
 
 type Api =
        "get" :> Get '[JSON] Person
   :<|> "delete" :> Delete
-  :<|> "capture" :> Capture "name" String :> Get '[JSON] Person
-  :<|> "body" :> ReqBody '[JSON] Person :> Post '[JSON] Person
-  :<|> "param" :> QueryParam "name" String :> Get '[JSON] Person
+  :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person
+  :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person
+  :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person
   :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person]
   :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool
-{-
   :<|> "matrixparam" :> MatrixParam "name" String :> Get '[JSON] Person
   :<|> "matrixparams" :> MatrixParams "name" String :> Get '[JSON] [Person]
   :<|> "matrixflag" :> MatrixFlag "flag" :> Get '[JSON] Bool
--}
   :<|> "rawSuccess" :> Raw
   :<|> "rawFailure" :> Raw
   :<|> "multiple" :>
@@ -80,14 +96,12 @@ server = serve api (
                    Nothing -> left (400, "missing parameter"))
   :<|> (\ names -> return (zipWith Person names [0..]))
   :<|> return
-{-
   :<|> (\ name -> case name of
                    Just "alice" -> return alice
                    Just name -> left (400, name ++ " not found")
                    Nothing -> left (400, "missing parameter"))
   :<|> (\ names -> return (zipWith Person names [0..]))
   :<|> return
--}
   :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")
   :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")
   :<|> \ a b c d -> return (a, b, c, d)
@@ -103,11 +117,9 @@ getBody :: Person -> BaseUrl -> EitherT String IO Person
 getQueryParam :: Maybe String -> BaseUrl -> EitherT String IO Person
 getQueryParams :: [String] -> BaseUrl -> EitherT String IO [Person]
 getQueryFlag :: Bool -> BaseUrl -> EitherT String IO Bool
-{-
 getMatrixParam :: Maybe String -> BaseUrl -> EitherT String IO Person
 getMatrixParams :: [String] -> BaseUrl -> EitherT String IO [Person]
 getMatrixFlag :: Bool -> BaseUrl -> EitherT String IO Bool
--}
 getRawSuccess :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
 getRawFailure :: Method -> BaseUrl -> EitherT String IO (Int, ByteString, MediaType)
 getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
@@ -120,11 +132,9 @@ getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
  :<|> getQueryParam
  :<|> getQueryParams
  :<|> getQueryFlag
-{-
  :<|> getMatrixParam
  :<|> getMatrixParams
  :<|> getMatrixFlag
--}
  :<|> getRawSuccess
  :<|> getRawFailure
  :<|> getMultiple)