test suite: Capture

src/Servant/Text.hs

@@ -5,6 +5,7 @@ module Servant.Text where
 
 import Data.String.Conversions
 import Data.Text
+import Text.Read
 
 class FromText a where
   fromText :: Text -> Maybe a
@@ -12,18 +13,21 @@ class FromText a where
 class ToText a where
   toText :: a -> Text
 
+
 instance FromText Text where
   fromText = Just
 
 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
@@ -32,3 +36,10 @@ instance FromText Bool where
 instance ToText Bool where
   toText True  = "true"
   toText False = "false"
+
+
+instance FromText Integer where
+  fromText = readMaybe . cs
+
+instance ToText Integer where
+  toText = cs . show

test/Servant/ServerSpec.hs

@@ -8,6 +8,7 @@
 module Servant.ServerSpec where
 
 
+import Control.Monad.Trans.Either
 import Data.Aeson
 import Data.Proxy
 import Data.String.Conversions
@@ -18,6 +19,7 @@ import Network.Wai.Test
 import Test.Hspec
 import Test.Hspec.Wai
 
+import Servant.API.Capture
 import Servant.API.Get
 import Servant.API.GetParam
 import Servant.API.Post
@@ -54,11 +56,15 @@ instance FromJSON Animal
 jerry :: Animal
 jerry = Animal "Mouse" 4
 
+tweety :: Animal
+tweety = Animal "Bird" 2
+
 
 -- * specs
 
 spec :: Spec
 spec = do
+  captureSpec
   getSpec
   getParamSpec
   postSpec
@@ -66,6 +72,25 @@ spec = do
   unionSpec
 
 
+type CaptureApi = Capture "legs" Integer :> Get Animal
+captureApi :: Proxy CaptureApi
+captureApi = Proxy
+captureServer :: Integer -> EitherT (Int, String) IO Animal
+captureServer legs = case legs of
+  4 -> return jerry
+  2 -> return tweety
+  _ -> left (404, "not found")
+
+captureSpec :: Spec
+captureSpec = do
+  describe "Servant.API.Capture" $ do
+    with (return (serve captureApi captureServer)) $ do
+      it "can capture parts of the 'pathInfo'" $ do
+        response <- get "/2"
+        liftIO $ do
+          decode' (simpleBody response) `shouldBe` Just tweety
+
+
 type GetApi = Get Person
 getApi :: Proxy GetApi
 getApi = Proxy