Use tasty for servant-docs tests
This commit is contained in:
parent
80a047d1d4
commit
f7bda98b6a
3 changed files with 73 additions and 15 deletions
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue