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.
build-depends:
base
, base-compat
, aeson
, lens
, servant
@ -101,7 +102,8 @@ test-suite spec
-- Additonal dependencies
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,28 +1,42 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -freduction-depth=100 #-}
module Servant.DocsSpec where
import Control.Lens
import Control.Monad
(unless)
import Control.Monad.Trans.Writer
(Writer, runWriter, tell)
import Data.Aeson
import Data.List
(isInfixOf)
import Data.Monoid
import Data.Proxy
import Data.String.Conversions
(cs)
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.Test.ComprehensiveAPI
import Servant.Docs.Internal
import Servant.Test.ComprehensiveAPI
-- * comprehensive api
@ -44,7 +58,7 @@ instance ToCapture (CaptureAll "foo" Int) where
-- * specs
spec :: Spec
spec :: TestTree
spec = describe "Servant.Docs" $ do
describe "markdown" $ do
@ -146,3 +160,38 @@ instance ToSample TT where
instance ToSample UT where
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