test suite: GetParam

src/Servant/Text.hs

@@ -1,6 +1,9 @@
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 module Servant.Text where
 
+import Data.String.Conversions
 import Data.Text
 
 class FromText a where
@@ -15,6 +18,12 @@ instance FromText Text where
 instance ToText Text where
   toText = id
 
+instance FromText String where
+  fromText = Just . cs
+
+instance ToText String where
+  toText = cs
+
 instance FromText Bool where
   fromText "true"  = Just True
   fromText "false" = Just False

test/Servant/ServerSpec.hs

@@ -11,11 +11,14 @@ module Servant.ServerSpec where
 import Data.Aeson
 import Data.Proxy
 import GHC.Generics
+import Network.HTTP.Types
+import Network.Wai
 import Network.Wai.Test
 import Test.Hspec
-import Test.Hspec.Wai as Wai
+import Test.Hspec.Wai
 
 import Servant.API.Get
+import Servant.API.GetParam
 import Servant.API.Post
 import Servant.API.RQBody
 import Servant.API.Sub
@@ -55,6 +58,7 @@ jerry = Animal "Mouse" 4
 spec :: Spec
 spec = do
   getSpec
+  getParamSpec
   postSpec
   unionSpec
 
@@ -76,6 +80,30 @@ getSpec :: Spec = do
         post "/" "" `shouldRespondWith` 404
 
 
+type GetParamApi = GetParam "name" String :> Get Person
+getParamApi :: Proxy GetParamApi
+getParamApi = Proxy
+
+getParamServer :: Server GetParamApi
+getParamServer (Just name) = return alice{name = name}
+getParamServer Nothing = return alice
+
+getParamSpec :: Spec
+getParamSpec = do
+  describe "Servant.API.GetParam" $ do
+    it "allows to retrieve GET parameters" $ do
+      (flip runSession) (serve getParamApi getParamServer) $ do
+        let params = "?name=bob"
+        response <- Network.Wai.Test.request defaultRequest{
+          rawQueryString = params,
+          queryString = parseQuery params
+         }
+        liftIO $ do
+          decode' (simpleBody response) `shouldBe` Just alice{
+            name = "bob"
+           }
+
+
 type PostApi = RQBody Person :> (Post Integer)
 postApi :: Proxy PostApi
 postApi = Proxy