[#149] Replace hspec with tasty

Problem: `hspec` and `tasty` are testing frameworks with
almost same functionality,
for historical reasons in xrefcheck we  used different frameworks
for tests and links-tests, and in Serokell we prefer `tasty` now.

Solution: use only `tasty`,
 rewrite code that use `hspec` using correspondance between
 - `testGroup` and `describe`
 -  `testCase` and `it`
 - `shouldBe` and `@?=`

.reuse/dep5

@@ -4,7 +4,7 @@ Files: .github/pull_request_template.md .github/ISSUE_TEMPLATE/*.md
 Copyright: 2018-2019 Serokell <https://serokell.io>
 License: Unlicense
 
-Files: links-tests/ftp_root/**/*
+Files: ftp-tests/ftp_root/**/*
 Copyright: 2021 Serokell <https://serokell.io>
 License: Unlicense
 

package.yaml

@@ -133,6 +133,7 @@ tests:
   xrefcheck-tests:
     main: Main.hs
     source-dirs: tests
+    build-tools: tasty-discover:tasty-discover
     generated-other-modules:
       - Paths_xrefcheck
     dependencies:
@@ -140,28 +141,25 @@ tests:
       - containers
       - cmark-gfm
       - firefly
-      - hspec
-      - hspec-expectations
-      - QuickCheck
       - xrefcheck
       - bytestring
       - directory
       - fmt
       - http-types
-      - HUnit
       - o-clock
       - regex-tdfa
+      - tasty
+      - tasty-hunit
+      - tasty-quickcheck
       - time
       - universum
       - modern-uri
       - uri-bytestring
       - yaml
-    build-tools:
-      - hspec-discover
 
-  links-tests:
+  ftp-tests:
     main: Main.hs
-    source-dirs: links-tests
+    source-dirs: ftp-tests
     build-tools: tasty-discover:tasty-discover
     generated-other-modules:
       - Paths_xrefcheck

tests/Main.hs

@@ -1,12 +1,15 @@
-{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
+-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
- -
+--
- - SPDX-License-Identifier: MPL-2.0
+-- SPDX-License-Identifier: MPL-2.0
- -}
+
+module Main
+  ( main
+  ) where
 
 import Universum
 
-import Spec (spec)
+import Test.Tasty
-import Test.Hspec (hspec)
+import Tree (tests)
 
 main :: IO ()
-main = hspec spec
+main = tests >>= defaultMain

tests/Spec.hs

@@ -1,6 +0,0 @@
-{- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
- -
- - SPDX-License-Identifier: MPL-2.0
- -}
-
-{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}

tests/Test/Xrefcheck/AnchorsInHeadersSpec.hs

@@ -7,21 +7,21 @@ module Test.Xrefcheck.AnchorsInHeadersSpec where
 
 import Universum
 
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
 
 import Xrefcheck.Core
 import Test.Xrefcheck.Util
 
-spec :: Spec
+test_anchorsInHeaders :: TestTree
-spec = do
+test_anchorsInHeaders = testGroup "Anchors in headers"
-    describe "Anchors in headers" $ do
+  [ testCase "Check if anchors in headers are recognized" $ do
-        it "Check if anchors in headers are recognized" $ do
+      fi <- getFI  GitHub "tests/markdowns/without-annotations/anchors_in_headers.md"
-            fi <- getFI GitHub "tests/markdowns/without-annotations/anchors_in_headers.md"
+      getAnchors fi @?= ["some-stuff", "stuff-section"]
-            getAnchors fi `shouldBe` ["some-stuff", "stuff-section"]
+  , testCase "Check if anchors with id attributes are recognized" $ do
-
+      fi <- getFI GitHub "tests/markdowns/without-annotations/anchors_in_headers_with_id_attribute.md"
-        it "Check if anchors with id attributes are recognized" $ do
+      getAnchors fi @?= ["some-stuff-with-id-attribute", "stuff-section-with-id-attribute"]
-            fi <- getFI GitHub "tests/markdowns/without-annotations/anchors_in_headers_with_id_attribute.md"
+  ]
-            getAnchors fi `shouldBe` ["some-stuff-with-id-attribute", "stuff-section-with-id-attribute"]
+  where
-    where
+    getAnchors :: FileInfo -> [Text]
-        getAnchors :: FileInfo -> [Text]
+    getAnchors fi = map aName $ fi ^. fiAnchors
-        getAnchors fi = map aName $ fi ^. fiAnchors

tests/Test/Xrefcheck/AnchorsSpec.hs

@@ -3,37 +3,36 @@
  - SPDX-License-Identifier: MPL-2.0
  -}
 
-module Test.Xrefcheck.AnchorsSpec (spec) where
+module Test.Xrefcheck.AnchorsSpec (test_anchors) where
 
 import Universum
 
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Tasty (testGroup, TestTree)
-import Test.QuickCheck ((===))
+import Test.Tasty.HUnit ((@?=), testCase)
 
 import Test.Xrefcheck.Util
 import Xrefcheck.Core
 
-checkHeaderConversions
+checkHeaderConversions :: Flavor -> [(Text, Text)] -> TestTree
-  :: HasCallStack
-  => Flavor -> [(Text, Text)] -> Spec
 checkHeaderConversions fl suites =
-  describe (show fl) $ do
+  testGroup (show fl) $
-    forM_ suites $ \(a, b) ->
+    [testCase (show a <> " == " <> show b) $ headerToAnchor fl a @?= b | (a,b) <- suites]
-      it (show a <> " == " <> show b) $ headerToAnchor fl a === b
+    ++
-    it "Non-stripped header name should be stripped" $ do
+    [ testCase "Non-stripped header name should be stripped" $ do
-      fi <- getFI fl "tests/markdowns/without-annotations/non_stripped_spaces.md"
+        fi <- getFI fl "tests/markdowns/without-annotations/non_stripped_spaces.md"
-      getAnchors fi `shouldBe` [ case fl of GitHub -> "header--with-leading-spaces"
+        getAnchors fi @?= [ case fl of GitHub -> "header--with-leading-spaces"
-                                            GitLab -> "header-with-leading-spaces"
+                                       GitLab -> "header-with-leading-spaces"
-                               , "edge-case"
+                          , "edge-case"
-                               ]
+                          ]
+    ]
   where
     getAnchors :: FileInfo -> [Text]
     getAnchors fi = map aName $ fi ^. fiAnchors
 
-spec :: Spec
+test_anchors :: TestTree
-spec = do
+test_anchors = do
-  describe "Header-to-anchor conversion" $ do
+  testGroup "Header-to-anchor conversion"
-    checkHeaderConversions GitHub
+    [ checkHeaderConversions GitHub
       [ ( "Some header"
         , "some-header"
         )
@@ -92,8 +91,7 @@ spec = do
         , "white_check_mark-checklist-for-your-pull-request"
         )
       ]
-
+    , checkHeaderConversions GitLab
-    checkHeaderConversions GitLab
       [ ( "a # b"
         , "a-b"
         )
@@ -134,3 +132,4 @@ spec = do
         , "white_check_mark-checklist-for-your-pull-request"
         )
       ]
+    ]

tests/Test/Xrefcheck/ConfigSpec.hs

@@ -12,63 +12,63 @@ import Control.Exception qualified as E
 
 import Data.ByteString qualified as BS
 import Network.HTTP.Types (Status (..))
-import Test.Hspec (Spec, before, describe, it, shouldBe)
+import Test.Tasty (TestTree, testGroup)
-import Test.Hspec.Expectations (expectationFailure)
+import Test.Tasty.QuickCheck (ioProperty, testProperty)
-import Test.QuickCheck (ioProperty, once)
 
 import Xrefcheck.Config (Config, Config' (..), VerifyConfig' (..), defConfig, defConfigText)
 import Xrefcheck.Core (Flavor (GitHub), allFlavors)
 import Xrefcheck.Verify (VerifyError (..), VerifyResult (..), checkExternalResource)
 
 import Test.Xrefcheck.Util (mockServer)
+import Test.Tasty.HUnit (testCase, assertFailure, (@?=))
 
-spec :: Spec
+test_config :: [TestTree]
-spec = do
+test_config =
-  describe "Default config is valid" $
+  [ testGroup "Default config is valid" [
-    forM_ allFlavors $ \flavor ->
+      testProperty (show flavor) $
-      it (show flavor) $
+        ioProperty $ evaluateWHNF_ @_ @Config (defConfig flavor)
-        once . ioProperty $ evaluateWHNF_ @_ @Config (defConfig flavor)
+        | flavor <- allFlavors]
 
-  describe "Filled default config matches the expected format" $
+  , testGroup "Filled default config matches the expected format" [
-    before (BS.readFile "tests/configs/github-config.yaml") $
+    -- The config we match against can be regenerated with
-      -- The config we match against can be regenerated with
+    -- stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml
-      -- stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml
+      testCase "Config matches" $ do
-      it "Config matches" $
+        config <- BS.readFile "tests/configs/github-config.yaml"
-        \config ->
+        when (config /= defConfigText GitHub) $
-          when (config /= defConfigText GitHub) $
+          assertFailure $ toString $ unwords
-            expectationFailure $ toString $ unwords
+            [ "Config does not match the expected format."
-              [ "Config does not match the expected format."
+            , "Run"
-              , "Run"
+            , "`stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml`"
-              , "`stack exec xrefcheck -- dump-config -t GitHub -o tests/configs/github-config.yaml`"
+            , "and verify changes"
-              , "and verify changes"
+            ]
+        ]
+  , testGroup "`ignoreAuthFailures` working as expected" $
+    let config = (cVerification $ defConfig GitHub) { vcIgnoreRefs = [] }
+    in [ testCase "when True - assume 401 status is valid" $
+          checkLinkWithServer (config { vcIgnoreAuthFailures = True })
+            "http://127.0.0.1:3000/401" $ VerifyResult []
+
+       , testCase "when False - assume 401 status is invalid" $
+          checkLinkWithServer (config { vcIgnoreAuthFailures = False })
+            "http://127.0.0.1:3000/401" $ VerifyResult
+              [ ExternalHttpResourceUnavailable $
+                  Status { statusCode = 401, statusMessage = "Unauthorized" }
               ]
 
-  describe "`ignoreAuthFailures` working as expected" $ do
+       , testCase "when True - assume 403 status is valid" $
-    let config = (cVerification $ defConfig GitHub) { vcIgnoreRefs = [] }
+          checkLinkWithServer (config { vcIgnoreAuthFailures = True })
+            "http://127.0.0.1:3000/403" $ VerifyResult []
 
-    it "when True - assume 401 status is valid" $
+       , testCase "when False - assume 403 status is invalid" $
-      checkLinkWithServer (config { vcIgnoreAuthFailures = True })
+          checkLinkWithServer (config { vcIgnoreAuthFailures = False })
-        "http://127.0.0.1:3000/401" $ VerifyResult []
+            "http://127.0.0.1:3000/403" $ VerifyResult
-
+              [ ExternalHttpResourceUnavailable $
-    it "when False - assume 401 status is invalid" $
+                  Status { statusCode = 403, statusMessage = "Forbidden" }
-      checkLinkWithServer (config { vcIgnoreAuthFailures = False })
+              ]
-        "http://127.0.0.1:3000/401" $ VerifyResult
+       ]
-          [ ExternalHttpResourceUnavailable $
+  ]
-              Status { statusCode = 401, statusMessage = "Unauthorized" }
-          ]
-
-    it "when True - assume 403 status is valid" $
-      checkLinkWithServer (config { vcIgnoreAuthFailures = True })
-        "http://127.0.0.1:3000/403" $ VerifyResult []
-
-    it "when False - assume 403 status is invalid" $
-      checkLinkWithServer (config { vcIgnoreAuthFailures = False })
-        "http://127.0.0.1:3000/403" $ VerifyResult
-          [ ExternalHttpResourceUnavailable $
-              Status { statusCode = 403, statusMessage = "Forbidden" }
-          ]
   where
     checkLinkWithServer config link expectation =
       E.bracket (forkIO mockServer) killThread $ \_ -> do
         result <- checkExternalResource config link
-        result `shouldBe` expectation
+        result @?= expectation

tests/Test/Xrefcheck/IgnoreAnnotationsSpec.hs

@@ -7,46 +7,52 @@ module Test.Xrefcheck.IgnoreAnnotationsSpec where
 
 import Universum
 
-import CMarkGFM (PosInfo (..))
+import CMarkGFM (PosInfo(..))
-import Test.Hspec (Spec, describe, it, shouldBe, shouldReturn)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
 
 import Test.Xrefcheck.Util
 import Xrefcheck.Core
 import Xrefcheck.Scan
 import Xrefcheck.Scanners.Markdown
 
-spec :: Spec
+test_ignoreAnnotations :: [TestTree]
-spec = do
+test_ignoreAnnotations =
-  describe "Parsing failures" $ do
+  [ testGroup "Parsing failures"
-    it "Check if broken link annotation produce error" do
+      [ testCase "Check if broken link annotation produce error" do
-      let file = "tests/markdowns/with-annotations/no_link.md"
+          let file = "tests/markdowns/with-annotations/no_link.md"
-      getErrs file `shouldReturn`
+          errs <- getErrs file
-        makeError (Just $ PosInfo 7 1 7 31) file Link ""
+          errs @?= makeError (Just $ PosInfo 7 1 7 31) file Link ""
-    it "Check if broken paragraph annotation produce error" do
+      , testCase "Check if broken paragraph annotation produce error" do
-      let file = "tests/markdowns/with-annotations/no_paragraph.md"
+          let file = "tests/markdowns/with-annotations/no_paragraph.md"
-      getErrs file `shouldReturn`
+          errs <- getErrs file
-        makeError (Just $ PosInfo 7 1 7 35) file Paragraph "HEADING"
+          errs @?= makeError (Just $ PosInfo 7 1 7 35) file Paragraph "HEADING"
-    it "Check if broken ignore file annotation produce error" do
+      , testCase "Check if broken ignore file annotation produce error" do
-      let file = "tests/markdowns/with-annotations/unexpected_ignore_file.md"
+          let file = "tests/markdowns/with-annotations/unexpected_ignore_file.md"
-      getErrs file `shouldReturn`
+          errs <- getErrs file
-        makeError (Just $ PosInfo 9 1 9 30) file File ""
+          errs @?= makeError (Just $ PosInfo 9 1 9 30) file File ""
-    it "Check if broken unrecognised annotation produce error" do
+      , testCase "Check if broken unrecognised annotation produce error" do
-      let file = "tests/markdowns/with-annotations/unrecognised_option.md"
+          let file = "tests/markdowns/with-annotations/unrecognised_option.md"
-      getErrs file `shouldReturn`
+          errs <- getErrs file
-        makeError (Just $ PosInfo 7 1 7 46) file None "unrecognised-option"
+          errs @?= makeError (Just $ PosInfo 7 1 7 46) file None "unrecognised-option"
-  describe "\"ignore link\" mode" $ do
+      ]
-    it "Check \"ignore link\" performance" $ do
+  , testGroup "\"ignore link\" mode"
-      fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_link.md"
+      [ testCase "Check \"ignore link\" performance" $ do
-      getRefs fi `shouldBe`
+          fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_link.md"
-        ["team", "team", "team", "hire-us", "how-we-work", "privacy", "link2", "link2"]
+          getRefs fi @?=
-  describe "\"ignore paragraph\" mode" $ do
+            ["team", "team", "team", "hire-us", "how-we-work", "privacy", "link2", "link2"]
-    it "Check \"ignore paragraph\" performance" $ do
+      ]
-      fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_paragraph.md"
+  , testGroup "\"ignore paragraph\" mode"
-      getRefs fi `shouldBe` ["blog", "contacts"]
+      [ testCase "Check \"ignore paragraph\" performance" $ do
-  describe "\"ignore file\" mode" $ do
+         fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_paragraph.md"
-    it "Check \"ignore file\" performance" $ do
+         getRefs fi @?= ["blog", "contacts"]
-      fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_file.md"
+      ]
-      getRefs fi `shouldBe` []
+  , testGroup "\"ignore file\" mode"
+      [ testCase "Check \"ignore file\" performance" $ do
+        fi <- getFI GitHub "tests/markdowns/with-annotations/ignore_file.md"
+        getRefs fi @?= []
+      ]
+  ]
   where
     getRefs :: FileInfo -> [Text]
     getRefs fi = map rName $ fi ^. fiReferences

tests/Test/Xrefcheck/IgnoreRegexSpec.hs

@@ -8,8 +8,8 @@ module Test.Xrefcheck.IgnoreRegexSpec where
 import Universum
 
 import Data.Yaml (decodeEither')
-import Test.HUnit (assertFailure)
+import Test.Tasty (TestTree, testGroup)
-import Test.Hspec (Spec, describe, it)
+import Test.Tasty.HUnit (testCase, assertFailure)
 import Text.Regex.TDFA (Regex)
 
 import Xrefcheck.Config
@@ -19,22 +19,23 @@ import Xrefcheck.Scan (scanRepo, specificFormatsSupport, ScanResult (..))
 import Xrefcheck.Scanners.Markdown
 import Xrefcheck.Verify (VerifyError, VerifyResult, WithReferenceLoc (..), verifyErrors, verifyRepo)
 
-spec :: Spec
+test_ignoreRegex :: TestTree
-spec = do
+test_ignoreRegex =
-  describe "Regular expressions performance" $ do
+  let root = "tests/markdowns/without-annotations"
-    let root = "tests/markdowns/without-annotations"
+      showProgressBar = False
-    let showProgressBar = False
+      formats = specificFormatsSupport [markdownSupport defGithubMdConfig]
-    let formats = specificFormatsSupport [markdownSupport defGithubMdConfig]
+      verifyMode = ExternalOnlyMode
-    let verifyMode = ExternalOnlyMode
 
-    let linksTxt =
+      linksTxt =
-          [ "https://bad.((external.)?)reference(/?)"
+        [ "https://bad.((external.)?)reference(/?)"
-          , "https://bad.reference.(org|com)"
+        , "https://bad.reference.(org|com)"
-          ]
+        ]
-    let regexs = linksToRegexs linksTxt
+      regexs = linksToRegexs linksTxt
-    let config = setIgnoreRefs regexs (defConfig GitHub)
+      config = setIgnoreRefs regexs (defConfig GitHub)
 
-    it "Check that only not matched links are verified" $ do
+
+  in testGroup "Regular expressions performance"
+    [ testCase "Check that only not matched links are verified" $ do
       scanResult <- allowRewrite showProgressBar $ \rw ->
         scanRepo rw formats (config ^. cTraversalL) root
 
@@ -69,6 +70,7 @@ spec = do
           assertFailure $
             "Link \"" <> show link <>
             "\" is not considered as broken but it is (and shouldn't be ignored)"
+    ]
 
     where
       pickBrokenLinks :: VerifyResult (WithReferenceLoc VerifyError) -> [Text]

tests/Test/Xrefcheck/LocalSpec.hs

@@ -7,19 +7,19 @@ module Test.Xrefcheck.LocalSpec where
 
 import Universum
 
-import Test.Hspec (Spec, describe, it)
+import Test.Tasty (TestTree, testGroup)
-import Test.QuickCheck ((===))
+import Test.Tasty.HUnit (testCase, (@?=))
 
 import Xrefcheck.Core (canonizeLocalRef)
 
-spec :: Spec
+test_local_refs_canonizing :: TestTree
-spec = do
+test_local_refs_canonizing = testGroup "Local refs canonizing" $
-  describe "Local refs canonizing" $ do
+    [ testCase "Strips ./" $
-    it "Strips ./" $
+        canonizeLocalRef "./AnchorsSpec.hs" @?= "AnchorsSpec.hs"
-      canonizeLocalRef "./AnchorsSpec.hs" === "AnchorsSpec.hs"
 
-    it "Strips ././" $
+    , testCase "Strips ././" $
-      canonizeLocalRef "././AnchorsSpec.hs" === "AnchorsSpec.hs"
+        canonizeLocalRef "././AnchorsSpec.hs" @?= "AnchorsSpec.hs"
 
-    it "Leaves plain other intact" $
+    , testCase "Leaves plain other intact" $
-      canonizeLocalRef "../AnchorsSpec.hs" === "../AnchorsSpec.hs"
+        canonizeLocalRef "../AnchorsSpec.hs" @?= "../AnchorsSpec.hs"
+    ]

tests/Test/Xrefcheck/TooManyRequestsSpec.hs

@@ -16,8 +16,8 @@ import Data.Time.Clock.POSIX (getPOSIXTime)
 import Fmt (indentF, pretty, unlinesF)
 import Network.HTTP.Types (Status (..), ok200, serviceUnavailable503, tooManyRequests429)
 import Network.HTTP.Types.Header (hRetryAfter)
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Test.Tasty (testGroup, TestTree)
-import Test.HUnit (assertBool)
+import Test.Tasty.HUnit (testCase, (@?=), assertBool)
 import Time (sec, (-:-))
 import Web.Firefly (ToResponse (toResponse), route, run, getMethod)
 
@@ -27,19 +27,18 @@ import Xrefcheck.Progress
 import Xrefcheck.Util
 import Xrefcheck.Verify
 
-spec :: Spec
+test_tooManyRequests :: TestTree
-spec = do
+test_tooManyRequests = testGroup "429 response tests"
-  describe "429 response tests" $ do
+  [ testCase "Returns 200 eventually" $ do
-    it "Returns 200 eventually" $ do
       let prog = Progress{ pTotal = 1
-                         , pCurrent = 1
+                          , pCurrent = 1
-                         , pErrorsUnfixable = 0
+                          , pErrorsUnfixable = 0
-                         , pErrorsFixable = 0
+                          , pErrorsFixable = 0
-                         , pTaskTimestamp = Nothing
+                          , pTaskTimestamp = Nothing
-                         }
+                          }
       checkLinkAndProgressWithServer (mock429 "1" ok200)
         "http://127.0.0.1:5000/429" prog $ VerifyResult []
-    it "Returns 503 eventually" $ do
+  , testCase "Returns 503 eventually" $ do
       let prog = Progress{ pTotal = 1
                          , pCurrent = 1
                          , pErrorsUnfixable = 1
@@ -51,7 +50,7 @@ spec = do
           [ ExternalHttpResourceUnavailable $
               Status { statusCode = 503, statusMessage = "Service Unavailable"}
           ]
-    it "Successfully updates the new retry-after value (as seconds)" $ do
+  , testCase "Successfully updates the new retry-after value (as seconds)" $ do
       E.bracket (forkIO $ mock429 "2" ok200) killThread $ \_ -> do
         now <- getPOSIXTime <&> posixTimeToTimeSecond
         progressRef <- newIORef VerifyProgress
@@ -72,7 +71,7 @@ spec = do
         flip assertBool (ttc == Just (sec 2)) $
           "Expected time to completion be equal to " ++ show (Just $ sec 2) ++
           ", but instead it's " ++ show ttc
-    it "Successfully updates the new retry-after value (as date)" $ do
+  , testCase "Successfully updates the new retry-after value (as date)" $ do
       utctime <- getCurrentTime
       let
         -- Set the @Retry-After@ response header value as (current datetime + 4 seconds)
@@ -97,7 +96,8 @@ spec = do
         flip assertBool (sec 3 <= ttc && ttc <= sec 4) $
           "Expected time to completion be within range (seconds): 3 <= x <= 4" ++
           ", but instead it's " ++ show ttc
-    it "Sets the new retry-after to 0 seconds if its value is a date && has already passed" $ do
+  , testCase "Sets the new retry-after to 0 seconds if\
+                    \ its value is a date && has already passed" $ do
       utctime <- getCurrentTime
       let
         -- Set the @Retry-After@ response header value as (current datetime - 4 seconds)
@@ -122,7 +122,7 @@ spec = do
         flip assertBool (ttc == Just (sec 0)) $
           "Expected time to completion be 0 seconds" ++
           ", but instead it's " ++ show ttc
-    it "The GET request should not be attempted after catching a 429" $ do
+    , testCase "The GET request should not be attempted after catching a 429" $ do
       let
         mock429WithGlobalIORef :: IORef [(Text, Status)] -> IO ()
         mock429WithGlobalIORef infoReverseAccumulatorRef = do
@@ -151,11 +151,12 @@ spec = do
       E.bracket (forkIO $ mock429WithGlobalIORef infoReverseAccumulatorRef) killThread $ \_ -> do
         _ <- verifyLink "http://127.0.0.1:5000/429grandfinale"
         infoReverseAccumulator <- readIORef infoReverseAccumulatorRef
-        reverse infoReverseAccumulator `shouldBe`
+        reverse infoReverseAccumulator @?=
           [ ("HEAD", tooManyRequests429)
           , ("HEAD", serviceUnavailable503)
           , ("GET", ok200)
           ]
+  ]
   where
     checkLinkAndProgressWithServer mock link progress vrExpectation =
       E.bracket (forkIO mock) killThread $ \_ -> do

tests/Test/Xrefcheck/TrailingSlashSpec.hs

@@ -9,7 +9,8 @@ import Universum
 
 import Fmt (blockListF, pretty, unlinesF)
 import System.Directory (doesFileExist)
-import Test.Hspec (Spec, describe, expectationFailure, it)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, assertFailure)
 
 import Xrefcheck.Config
 import Xrefcheck.Core
@@ -17,25 +18,24 @@ import Xrefcheck.Progress
 import Xrefcheck.Scan
 import Xrefcheck.Scanners.Markdown
 
-spec :: Spec
+test_slash :: TestTree
-spec = do
+test_slash = testGroup "Trailing forward slash detection" $
-  describe "Trailing forward slash detection" $ do
+  let config = defConfig GitHub
-    let config = defConfig GitHub
+      format = specificFormatsSupport [markdownSupport (scMarkdown (cScanners config))]
-    let format = specificFormatsSupport [markdownSupport (scMarkdown (cScanners config))]
+  in roots <&> \root ->
-    forM_ roots $ \root -> do
+    testCase ("All the files within the root \"" <>
-      it ("All the files within the root \"" <>
+      root <>
-          root <>
+      "\" should exist") $ do
-          "\" should exist") $ do
         (ScanResult _ (RepoInfo repoInfo)) <- allowRewrite False $ \rw ->
           scanRepo rw format TraversalConfig{ tcIgnored = [] } root
         nonExistentFiles <- lefts <$> forM (keys repoInfo) (\filePath -> do
           predicate <- doesFileExist filePath
           return $ if predicate
-                   then Right ()
+                    then Right ()
-                   else Left filePath)
+                    else Left filePath)
         if null nonExistentFiles
         then pass
-        else expectationFailure $ pretty $ unlinesF
+        else assertFailure $ pretty $ unlinesF
           [ "Expected all filepaths to be valid, but these filepaths do not exist:"
           , blockListF nonExistentFiles
           ]

tests/Test/Xrefcheck/URIParsingSpec.hs

@@ -9,45 +9,49 @@ module Test.Xrefcheck.URIParsingSpec where
 
 import Universum
 
-import Test.Hspec (Spec, describe, it, shouldReturn)
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
 import Text.URI (URI)
 import Text.URI.QQ (uri)
-import URI.ByteString (URIParseError (..), SchemaError (..))
+import URI.ByteString (SchemaError (..), URIParseError (..))
 
-import Xrefcheck.Verify (parseUri, VerifyError (..))
+import Xrefcheck.Verify (VerifyError (..), parseUri)
 
-spec :: Spec
+test_uri :: [TestTree]
-spec = do
+test_uri =
-  describe "URI parsing should be successful" $ do
+  [ testGroup "URI parsing should be successful"
-    it "Without the special characters in the query strings" do
+      [ testCase "Without the special characters in the query strings" do
-      parseUri' "https://example.com/?q=a&p=b#fragment" `shouldReturn`
+          parseUri' "https://example.com/?q=a&p=b#fragment" >>=
-        Right [uri|https://example.com/?q=a&p=b#fragment|]
+            (@?= Right [uri|https://example.com/?q=a&p=b#fragment|])
+          parseUri' "https://example.com/path/to/smth?q=a&p=b" >>=
+            (@?= Right [uri|https://example.com/path/to/smth?q=a&p=b|])
 
-      parseUri' "https://example.com/path/to/smth?q=a&p=b" `shouldReturn`
+      , testCase "With the special characters in the query strings" do
-        Right [uri|https://example.com/path/to/smth?q=a&p=b|]
+          parseUri' "https://example.com/?q=[a]&<p>={b}#fragment" >>=
+            (@?= Right
+              [uri|https://example.com/?q=%5Ba%5D&%3Cp%3E=%7Bb%7D#fragment|])
 
-    it "With the special characters in the query strings" do
+          parseUri' "https://example.com/path/to/smth?q=[a]&<p>={b}" >>=
-      parseUri' "https://example.com/?q=[a]&<p>={b}#fragment" `shouldReturn`
+            (@?= Right
-        Right [uri|https://example.com/?q=%5Ba%5D&%3Cp%3E=%7Bb%7D#fragment|]
+              [uri|https://example.com/path/to/smth?q=%5Ba%5D&%3Cp%3E=%7Bb%7D|])
+      ]
+  , testGroup "URI parsing should be unsuccessful"
+      [ testCase "With the special characters anywhere else" do
+          parseUri' "https://exa<mple.co>m/?q=a&p=b#fra{g}ment" >>=
+            (@?= Left (ExternalResourceInvalidUri MalformedPath))
 
-      parseUri' "https://example.com/path/to/smth?q=[a]&<p>={b}" `shouldReturn`
+          parseUri' "https://example.com/pa[t]h/to[/]smth?q=a&p=b" >>=
-        Right [uri|https://example.com/path/to/smth?q=%5Ba%5D&%3Cp%3E=%7Bb%7D|]
+            (@?= Left (ExternalResourceInvalidUri MalformedPath))
 
-  describe "URI parsing should be unsuccessful" $ do
+      , testCase "With malformed scheme" do
-    it "With the special characters anywhere else" do
+          parseUri' "https//example.com/" >>=
-      parseUri' "https://exa<mple.co>m/?q=a&p=b#fra{g}ment" `shouldReturn`
+            (@?= Left (ExternalResourceInvalidUri $ MalformedScheme MissingColon))
-        Left (ExternalResourceInvalidUri MalformedPath)
 
-      parseUri' "https://example.com/pa[t]h/to[/]smth?q=a&p=b" `shouldReturn`
+      , testCase "With malformed fragment" do
-        Left (ExternalResourceInvalidUri MalformedPath)
+          parseUri' "https://example.com/?q=a&p=b#fra{g}ment" >>=
-
+            (@?= Left (ExternalResourceInvalidUri MalformedFragment))
-    it "With malformed scheme" do
+      ]
-      parseUri' "https//example.com/" `shouldReturn`
+  ]
-        Left (ExternalResourceInvalidUri $ MalformedScheme MissingColon)
-
-    it "With malformed fragment" do
-      parseUri' "https://example.com/?q=a&p=b#fra{g}ment" `shouldReturn`
-        Left (ExternalResourceInvalidUri MalformedFragment)
   where
     parseUri' :: Text -> IO $ Either VerifyError URI
     parseUri' = runExceptT . parseUri

tests/Tree.hs

@@ -0,0 +1,5 @@
+-- SPDX-FileCopyrightText: 2022 Serokell <https://serokell.io>
+--
+-- SPDX-License-Identifier: MPL-2.0
+
+{-# OPTIONS_GHC -F -pgmF tasty-discover -optF --tree-display -optF --generated-module -optF Tree #-}

xrefcheck.nix

@@ -15,7 +15,7 @@ let
           [ "-Werror" ];
 
         components.tests = {
-          links-tests = {
+          ftp-tests = {
             build-tools = [ pkgs.vsftpd ];
             preCheck = ''
               echo "Starting vsftpd..."
@@ -25,7 +25,7 @@ let
               -olisten_port=2221 \
               -olisten=yes \
               -oftp_username=$(whoami) \
-              -oanon_root=${./links-tests/ftp_root} \
+              -oanon_root=${./ftp-tests/ftp_root} \
               -opasv_min_port=2222 \
               -ohide_file='{.*}' \
               -odeny_file='{.*}' \