on master help sign in
Use tasty for servant-docs tests
f7bda98Oleg Grenrus
servant-docs/servant-docs.cabal+5−3
@@ -93,6 +93,7 @@ test-suite spec
93 -- Dependencies inherited from the library. No need to specify bounds.
93 -- Dependencies inherited from the library. No need to specify bounds.
94 build-depends:
94 build-depends:
95 base
95 base
96+ , base-compat
96 , aeson
97 , aeson
97 , lens
98 , lens
98 , servant
99 , servant
@@ -101,7 +102,8 @@ test-suite spec
101
102
102 -- Additonal dependencies
103 -- Additonal dependencies
103 build-depends:
104 build-depends:
104− hspec >= 2.4.4 && < 2.6
105+ tasty >= 1.1.0.4 && < 1.2,
106+ tasty-golden >= 2.3.2 && < 2.4,
107+ tasty-hunit >= 0.10.0.1 && < 0.11,
108+ transformers >= 0.5.2.0 && < 0.6
105
109
106− build-tool-depends:
107− hspec-discover:hspec-discover >=2.4.4 && <2.6
servant-docs/test/Servant/DocsSpec.hs+60−11
@@ -1,28 +1,42 @@
1−{-# LANGUAGE DataKinds #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE DeriveGeneric #-}
3+{-# LANGUAGE DeriveGeneric #-}
3−{-# LANGUAGE FlexibleContexts #-}
4+{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE GADTs #-}
7+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
8+{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE TypeOperators #-}
10+{-# LANGUAGE TypeOperators #-}
8−{-# LANGUAGE TypeSynonymInstances #-}
11+{-# LANGUAGE TypeSynonymInstances #-}
9{-# OPTIONS_GHC -fno-warn-orphans #-}
12{-# OPTIONS_GHC -fno-warn-orphans #-}
10{-# OPTIONS_GHC -freduction-depth=100 #-}
13{-# OPTIONS_GHC -freduction-depth=100 #-}
11
14
12module Servant.DocsSpec where
15module Servant.DocsSpec where
13
16
14import Control.Lens
17import Control.Lens
18+import Control.Monad
19+ (unless)
20+import Control.Monad.Trans.Writer
21+ (Writer, runWriter, tell)
15import Data.Aeson
22import Data.Aeson
23+import Data.List
24+ (isInfixOf)
16import Data.Monoid
25import Data.Monoid
17import Data.Proxy
26import Data.Proxy
18import Data.String.Conversions
27import Data.String.Conversions
19 (cs)
28 (cs)
20import GHC.Generics
29import GHC.Generics
21−import Test.Hspec
30+import Prelude ()
31+import Prelude.Compat
32+import Test.Tasty
33+ (TestName, TestTree, testGroup)
34+import Test.Tasty.HUnit
35+ (Assertion, HasCallStack, assertFailure, testCase, (@?=))
22
36
23import Servant.API
37import Servant.API
24−import Servant.Test.ComprehensiveAPI
25import Servant.Docs.Internal
38import Servant.Docs.Internal
39+import Servant.Test.ComprehensiveAPI
26
40
27-- * comprehensive api
41-- * comprehensive api
28
42
@@ -44,7 +58,7 @@ instance ToCapture (CaptureAll "foo" Int) where
44
58
45-- * specs
59-- * specs
46
60
47−spec :: Spec
61+spec :: TestTree
48spec = describe "Servant.Docs" $ do
62spec = describe "Servant.Docs" $ do
49
63
50 describe "markdown" $ do
64 describe "markdown" $ do
@@ -146,3 +160,38 @@ instance ToSample TT where
146
160
147instance ToSample UT where
161instance ToSample UT where
148 toSamples _ = [("yks", UT1), ("kaks", UT2)]
162 toSamples _ = [("yks", UT1), ("kaks", UT2)]
163+
164+-------------------------------------------------------------------------------
165+-- HSpec like DSL for tasty
166+-------------------------------------------------------------------------------
167+
168+newtype TestTreeM a = TestTreeM (Writer [TestTree] a)
169+ deriving (Functor, Applicative, Monad)
170+
171+runTestTreeM :: TestTreeM () -> [TestTree]
172+runTestTreeM (TestTreeM m) = snd (runWriter m)
173+
174+class Describe r where
175+ describe :: TestName -> TestTreeM () -> r
176+
177+instance a ~ () => Describe (TestTreeM a) where
178+ describe n t = TestTreeM $ tell [ describe n t ]
179+
180+instance Describe TestTree where
181+ describe n t = testGroup n $ runTestTreeM t
182+
183+it :: TestName -> Assertion -> TestTreeM ()
184+it n assertion = TestTreeM $ tell [ testCase n assertion ]
185+
186+shouldBe :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion
187+shouldBe = (@?=)
188+
189+shouldContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
190+shouldContain = compareWith (flip isInfixOf) "does not contain"
191+
192+shouldNotContain :: (Eq a, Show a, HasCallStack) => [a] -> [a] -> Assertion
193+shouldNotContain = compareWith (\x y -> not (isInfixOf y x)) "contains"
194+
195+compareWith :: (Show a, Show b, HasCallStack) => (a -> b -> Bool) -> String -> a -> b -> Assertion
196+compareWith f msg x y = unless (f x y) $ assertFailure $
197+ show x ++ " " ++ msg ++ " " ++ show y
servant-docs/test/Spec.hs+8−1
@@ -1 +1,8 @@
1−{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
1+module Main (main) where
2+
3+import Test.Tasty
4+ (defaultMain)
5+import qualified Servant.DocsSpec
6+
7+main :: IO ()
8+main = defaultMain Servant.DocsSpec.spec