Use tasty for servant-docs tests

This commit is contained in:
Oleg Grenrus 2018-11-08 15:35:48 +02:00
parent 80a047d1d4
commit f7bda98b6a
3 changed files with 73 additions and 15 deletions

View file

@ -93,6 +93,7 @@ test-suite spec
-- Dependencies inherited from the library. No need to specify bounds. -- Dependencies inherited from the library. No need to specify bounds.
build-depends: build-depends:
base base
, base-compat
, aeson , aeson
, lens , lens
, servant , servant
@ -101,7 +102,8 @@ test-suite spec
-- Additonal dependencies -- Additonal dependencies
build-depends: build-depends:
hspec >= 2.4.4 && < 2.6 tasty >= 1.1.0.4 && < 1.2,
tasty-golden >= 2.3.2 && < 2.4,
tasty-hunit >= 0.10.0.1 && < 0.11,
transformers >= 0.5.2.0 && < 0.6
build-tool-depends:
hspec-discover:hspec-discover >=2.4.4 && <2.6

View file

@ -1,7 +1,10 @@
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
@ -12,17 +15,28 @@
module Servant.DocsSpec where module Servant.DocsSpec where
import Control.Lens import Control.Lens
import Control.Monad
(unless)
import Control.Monad.Trans.Writer
(Writer, runWriter, tell)
import Data.Aeson import Data.Aeson
import Data.List
(isInfixOf)
import Data.Monoid import Data.Monoid
import Data.Proxy import Data.Proxy
import Data.String.Conversions import Data.String.Conversions
(cs) (cs)
import GHC.Generics import GHC.Generics
import Test.Hspec import Prelude ()
import Prelude.Compat
import Test.Tasty
(TestName, TestTree, testGroup)
import Test.Tasty.HUnit
(Assertion, HasCallStack, assertFailure, testCase, (@?=))
import Servant.API import Servant.API
import Servant.Test.ComprehensiveAPI
import Servant.Docs.Internal import Servant.Docs.Internal
import Servant.Test.ComprehensiveAPI
-- * comprehensive api -- * comprehensive api
@ -44,7 +58,7 @@ instance ToCapture (CaptureAll "foo" Int) where
-- * specs -- * specs
spec :: Spec spec :: TestTree
spec = describe "Servant.Docs" $ do spec = describe "Servant.Docs" $ do
describe "markdown" $ do describe "markdown" $ do
@ -146,3 +160,38 @@ instance ToSample TT where
instance ToSample UT where instance ToSample UT where
toSamples _ = [("yks", UT1), ("kaks", UT2)] toSamples _ = [("yks", UT1), ("kaks", UT2)]
-------------------------------------------------------------------------------
-- HSpec like DSL for tasty
-------------------------------------------------------------------------------
newtype TestTreeM a = TestTreeM (Writer [TestTree] a)
deriving (Functor, Applicative, Monad)
runTestTreeM :: TestTreeM () -> [TestTree]
runTestTreeM (TestTreeM m) = snd (runWriter m)
class Describe r where
describe :: TestName -> TestTreeM () -> r
instance a ~ () => Describe (TestTreeM a) where
describe n t = TestTreeM $ tell [ describe n t ]
instance Describe TestTree where
describe n t = testGroup n $ runTestTreeM t
it :: TestName -> Assertion -> TestTreeM ()
it n assertion = TestTreeM $ tell [ testCase n assertion ]
shouldBe :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion
shouldBe = (@?=)
shouldContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
shouldContain = compareWith (flip isInfixOf) "does not contain"
shouldNotContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
shouldNotContain = compareWith (\x y -> not (isInfixOf y x)) "contains"
compareWith :: (Show a, Show b, HasCallStack) => (a -> b -> Bool) -> String -> a -> b -> Assertion
compareWith f msg x y = unless (f x y) $ assertFailure $
show x ++ " " ++ msg ++ " " ++ show y

View file

@ -1 +1,8 @@
{-# OPTIONS_GHC -F -pgmF hspec-discover #-} module Main (main) where
import Test.Tasty
(defaultMain)
import qualified Servant.DocsSpec
main :: IO ()
main = defaultMain Servant.DocsSpec.spec