servant/servant-docs/test/Servant/DocsSpec.hs

149 lines
4.8 KiB
Haskell
Raw Normal View History

2017-06-19 17:58:25 +02:00
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -freduction-depth=100 #-}
2015-04-08 16:27:38 +02:00
module Servant.DocsSpec where
import Control.Lens
2015-04-08 16:27:38 +02:00
import Data.Aeson
import Data.Monoid
2015-04-08 16:27:38 +02:00
import Data.Proxy
2018-06-29 21:08:26 +02:00
import Data.String.Conversions
(cs)
2015-04-08 16:27:38 +02:00
import GHC.Generics
import Test.Hspec
import Servant.API
import Servant.API.Internal.Test.ComprehensiveAPI
2015-04-08 16:27:38 +02:00
import Servant.Docs.Internal
-- * comprehensive api
-- This declaration simply checks that all instances are in place.
_ = docs comprehensiveAPI
instance ToParam (QueryParam' mods "foo" Int) where
toParam = error "unused"
instance ToParam (QueryParam' mods "bar" Int) where
toParam = error "unused"
instance ToParam (QueryParams "foo" Int) where
toParam = error "unused"
instance ToParam (QueryFlag "foo") where
toParam = error "unused"
instance ToCapture (Capture "foo" Int) where
toCapture = error "unused"
2016-07-04 14:47:34 +02:00
instance ToCapture (CaptureAll "foo" Int) where
toCapture = error "unused"
-- * specs
2015-04-08 16:27:38 +02:00
spec :: Spec
spec = describe "Servant.Docs" $ do
describe "markdown" $ do
let md = markdown (docs (Proxy :: Proxy TestApi1))
tests md
describe "markdown with extra info" $ do
let
extra = extraInfo
(Proxy :: Proxy (Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)))
(defAction & notes <>~ [DocNote "Get an Integer" ["get an integer in Json or plain text"]])
<>
extraInfo
(Proxy :: Proxy (ReqBody '[JSON] String :> Post '[JSON] Datatype1))
(defAction & notes <>~ [DocNote "Post data" ["Posts some Json data"]])
md = markdown (docsWith defaultDocOptions [] extra (Proxy :: Proxy TestApi1))
tests md
it "contains the extra info provided" $ do
md `shouldContain` "Get an Integer"
md `shouldContain` "Post data"
md `shouldContain` "get an integer in Json or plain text"
md `shouldContain` "Posts some Json data"
2015-09-16 12:42:05 +02:00
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`
2015-09-21 11:46:21 +02:00
[ ("eins, yks",(TT1,UT1)), ("eins, kaks",(TT1,UT2))
, ("zwei, yks",(TT2,UT1)), ("zwei, kaks",(TT2,UT2))
2015-09-16 12:42:05 +02:00
]
(toSamples (Proxy :: Proxy (TT, UT, UT))) `shouldBe`
2015-09-21 11:46:21 +02:00
[ ("eins, yks, yks",(TT1,UT1,UT1))
, ("eins, yks, kaks",(TT1,UT1,UT2))
, ("zwei, yks, yks",(TT2,UT1,UT1))
, ("eins, kaks, yks",(TT1,UT2,UT1))
, ("zwei, yks, kaks",(TT2,UT1,UT2))
, ("eins, kaks, kaks",(TT1,UT2,UT2))
, ("zwei, kaks, yks",(TT2,UT2,UT1))
, ("zwei, kaks, kaks",(TT2,UT2,UT2))
2015-09-16 12:42:05 +02:00
]
where
tests md = do
2015-04-08 16:27:38 +02:00
it "mentions supported content-types" $ do
md `shouldContain` "application/json"
md `shouldContain` "text/plain;charset=utf-8"
it "mentions status codes" $ do
md `shouldContain` "Status code 200"
it "has methods as section headers" $ do
md `shouldContain` "## POST"
md `shouldContain` "## GET"
2015-04-08 16:27:38 +02:00
it "mentions headers" $ do
md `shouldContain` "- This endpoint is sensitive to the value of the **X-Test** HTTP header."
it "contains response samples" $
2015-04-08 16:27:38 +02:00
md `shouldContain` "{\"dt1field1\":\"field 1\",\"dt1field2\":13}"
it "contains request body samples" $
2015-04-08 16:27:38 +02:00
md `shouldContain` "17"
it "does not generate any docs mentioning the 'empty-api' path" $
md `shouldNotContain` "empty-api"
2015-04-08 16:27:38 +02:00
-- * APIs
data Datatype1 = Datatype1 { dt1field1 :: String
, dt1field2 :: Int
} deriving (Eq, Show, Generic)
instance ToJSON Datatype1
instance ToSample Datatype1 where
2015-09-21 11:46:21 +02:00
toSamples _ = singleSample $ Datatype1 "field 1" 13
2015-04-08 16:27:38 +02:00
instance ToSample Char where
toSamples _ = samples ['a'..'z']
2015-04-08 16:27:38 +02:00
instance ToSample Int where
2015-09-21 11:46:21 +02:00
toSamples _ = singleSample 17
2015-04-08 16:27:38 +02:00
instance MimeRender PlainText Int where
2015-04-19 14:51:34 +02:00
mimeRender _ = cs . show
2015-04-08 16:27:38 +02:00
type TestApi1 = Get '[JSON, PlainText] (Headers '[Header "Location" String] Int)
2015-04-08 16:27:38 +02:00
:<|> ReqBody '[JSON] String :> Post '[JSON] Datatype1
:<|> Header "X-Test" Int :> Put '[JSON] Int
:<|> "empty-api" :> EmptyAPI
2015-04-08 16:27:38 +02:00
2015-09-16 12:42:05 +02:00
data TT = TT1 | TT2 deriving (Show, Eq)
data UT = UT1 | UT2 deriving (Show, Eq)
instance ToSample TT where
2015-09-16 12:42:05 +02:00
toSamples _ = [("eins", TT1), ("zwei", TT2)]
instance ToSample UT where
2015-09-16 12:42:05 +02:00
toSamples _ = [("yks", UT1), ("kaks", UT2)]