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

Add tests.

Browse source
This commit is contained in:
Matthias Fischmann 2015-09-16 12:42:05 +02:00
parent e5259358db
commit d9df8f043e
1 changed files with 27 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
servant-docs/test/Servant/DocsSpec.hs
View file

@ -1,7 +1,9 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
@ -42,6 +44,21 @@ spec = describe "Servant.Docs" $ do
md `shouldContain` "get an integer in Json or plain text" md `shouldContain` "get an integer in Json or plain text"
md `shouldContain` "Posts some Json data" md `shouldContain` "Posts some Json data"
describe "tuple samples" $ do
it "looks like expected" $ do
(toSample (Proxy :: Proxy (TT, UT))) `shouldBe` Just (TT1,UT1)
(toSample (Proxy :: Proxy (TT, UT, UT))) `shouldBe` Just (TT1,UT1,UT1)
(toSamples (Proxy :: Proxy (TT, UT))) `shouldBe`
[ ("(eins, yks)",(TT1,UT1)), ("(eins, kaks)",(TT1,UT2))
, ("(zwei, yks)",(TT2,UT1)), ("(zwei, kaks)",(TT2,UT2))
]
(toSamples (Proxy :: Proxy (TT, UT, UT))) `shouldBe`
[ ("(eins, yks, yks)",(TT1,UT1,UT1)), ("(eins, yks, kaks)",(TT1,UT1,UT2))
, ("(eins, kaks, yks)",(TT1,UT2,UT1)), ("(eins, kaks, kaks)",(TT1,UT2,UT2))
, ("(zwei, yks, yks)",(TT2,UT1,UT1)), ("(zwei, yks, kaks)",(TT2,UT1,UT2))
, ("(zwei, kaks, yks)",(TT2,UT2,UT1)), ("(zwei, kaks, kaks)",(TT2,UT2,UT2))
]
where where
tests md = do tests md = do
it "mentions supported content-types" $ do it "mentions supported content-types" $ do
@ -81,7 +98,16 @@ instance ToSample Int Int where
instance MimeRender PlainText Int where instance MimeRender PlainText Int where
mimeRender _ = cs . show mimeRender _ = cs . show
type TestApi1 = Get '[JSON, PlainText] Int type TestApi1 = Get '[JSON, PlainText] Int
:<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1 :<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
data TT = TT1 | TT2 deriving (Show, Eq)
data UT = UT1 | UT2 deriving (Show, Eq)
instance ToSample TT TT where
toSample _ = Just TT1
toSamples _ = [("eins", TT1), ("zwei", TT2)]
instance ToSample UT UT where
toSample _ = Just UT1
toSamples _ = [("yks", UT1), ("kaks", UT2)]