sydtest-hspec (empty) → 0.0.0.0

raw patch · 6 files changed

+198/−0 lines, 6 filesdep +basedep +hspecdep +hspec-core

Dependencies added: base, hspec, hspec-core, mtl, sydtest, sydtest-hspec

Files

• LICENSE.md +5/−0
• src/Test/Syd/Hspec.hs +111/−0
• sydtest-hspec.cabal +55/−0
• test/Main.hs +10/−0
• test/Spec.hs +1/−0
• test/Test/Syd/HspecSpec.hs +16/−0

@@ -0,0 +1,5 @@+# Sydtest License++Copyright (c) 2021 Tom Sydney Kerckhove++See the Sydtest License at https://github.com/NorfairKing/sydtest/blob/master/sydtest/LICENSE.md for the full license text.

@@ -0,0 +1,111 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Syd.Hspec (fromHspec) where++import Control.Exception+import Control.Monad.Writer+import Data.List+import qualified Test.Hspec.Core.Spec as Hspec+import Test.Syd as Syd++-- | Import an Hspec 'Test.Hspec.Spec' as a Sydtest 'Test.Syd.Spec'.+--+-- The reasoning behind this function is that, eventhough migration from hspec+-- to sydtest is usually very simple, you might depend on certain libraries+-- beyond your control that still use hspec.  In that case you want to be able+-- to still use those libraries but also use sydtest already.+--+-- For this reason, and because hspec doesn't tell you wether a test is pending+-- until after you run it, pending tests are imported as passing tests.+fromHspec :: Hspec.Spec -> Syd.Spec+fromHspec (Hspec.SpecM specWriter) = do+  (result, trees) <- liftIO $ runWriterT specWriter+  mapM_ importSpecTree trees+  pure result++importSpecTree :: Hspec.SpecTree () -> Syd.Spec+importSpecTree = go+  where+    go = \case+      Hspec.Leaf item -> importItem item+      Hspec.Node d ts -> describe d $ mapM_ go ts+      -- Hspec.NodeWithCleanup's semantics are so weird that we can only do+      -- this translation if inner equals ().+      Hspec.NodeWithCleanup cleanup ts -> afterAll_ (cleanup ()) $ mapM_ go ts++importItem :: forall inner. Hspec.Item inner -> Syd.TestDefM '[] inner ()+importItem item@Hspec.Item {..} =+  let parallelMod = case itemIsParallelizable of+        Just True -> parallel+        Just False -> sequential+        Nothing -> id+   in parallelMod $+        it itemRequirement (ImportedItem item :: ImportedItem inner)++newtype ImportedItem a = ImportedItem (Hspec.Item a)++instance IsTest (ImportedItem a) where+  type Arg1 (ImportedItem a) = ()+  type Arg2 (ImportedItem a) = a+  runTest = runImportedItem++runImportedItem ::+  ImportedItem inner ->+  TestRunSettings ->+  ((() -> inner -> IO ()) -> IO ()) ->+  IO TestRunResult+runImportedItem (ImportedItem Hspec.Item {..}) trs wrapper = do+  errOrRes <- applyWrapper2 wrapper $ \() inner -> do+    let params :: Hspec.Params+        params =+          Hspec.Params+            { Hspec.paramsQuickCheckArgs = makeQuickCheckArgs trs,+              -- TODO use the right depth when sydtest supports smallcheck+              Hspec.paramsSmallCheckDepth = Hspec.paramsSmallCheckDepth Hspec.defaultParams+            }+        callback :: Hspec.ProgressCallback+        callback = const $ pure ()+    itemExample params (\takeInner -> takeInner inner) callback+  let (testRunResultStatus, testRunResultException) = case errOrRes of+        Left ex -> (TestFailed, Just ex)+        Right result -> case Hspec.resultStatus result of+          Hspec.Success -> (TestPassed, Nothing)+          -- This is certainly a debatable choice, but there's no need to make+          -- tests fail here, and there's no way to know ahead of time whether+          -- a test is pending so we have no choice.+          Hspec.Pending _ _ -> (TestPassed, Nothing)+          Hspec.Failure mloc fr ->+            let withExtraContext :: Maybe String -> Assertion -> Assertion+                withExtraContext = maybe id (\extraContext a -> Context a extraContext)+                niceLocation :: Hspec.Location -> String+                niceLocation Hspec.Location {..} = intercalate ":" [locationFile, show locationLine, show locationColumn]+                withLocationContext :: Assertion -> Assertion+                withLocationContext = withExtraContext $ niceLocation <$> mloc+                assertion = case fr of+                  Hspec.NoReason -> Right $ ExpectationFailed "Hspec had no more information about this failure."+                  Hspec.Reason s -> Right $ ExpectationFailed s+                  Hspec.ExpectedButGot mExtraContext expected actual -> Right $ withExtraContext mExtraContext $ NotEqualButShouldHaveBeenEqual actual expected+                  Hspec.Error mExtraContext e -> withExtraContext mExtraContext <$> Left (displayException e)+             in ( TestFailed,+                  Just+                    ( Context+                        <$> ( withLocationContext <$> assertion+                            )+                          <*> pure+                            (Hspec.resultInfo result)+                    )+                )+  let testRunResultNumTests = Nothing+  let testRunResultNumShrinks = Nothing+  let testRunResultGoldenCase = Nothing+  let testRunResultFailingInputs = []+  let testRunResultExtraInfo = Nothing+  let testRunResultLabels = Nothing+  let testRunResultClasses = Nothing+  let testRunResultTables = Nothing++  pure TestRunResult {..}

@@ -0,0 +1,55 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           sydtest-hspec+version:        0.0.0.0+synopsis:       An Hspec companion library for sydtest+category:       Testing+homepage:       https://github.com/NorfairKing/sydtest#readme+bug-reports:    https://github.com/NorfairKing/sydtest/issues+author:         Tom Sydney Kerckhove+maintainer:     syd@cs-syd.eu+copyright:      Copyright (c) 2021 Tom Sydney Kerckhove+license:        OtherLicense+license-file:   LICENSE.md+build-type:     Simple++source-repository head+  type: git+  location: https://github.com/NorfairKing/sydtest++library+  exposed-modules:+      Test.Syd.Hspec+  other-modules:+      Paths_sydtest_hspec+  hs-source-dirs:+      src+  build-depends:+      base >=4.7 && <5+    , hspec-core+    , mtl+    , sydtest+  default-language: Haskell2010++test-suite sydtest-hspec-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Spec+      Test.Syd.HspecSpec+      Paths_sydtest_hspec+  hs-source-dirs:+      test+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-tool-depends:+      sydtest-discover:sydtest-discover+  build-depends:+      base >=4.7 && <5+    , hspec+    , sydtest+    , sydtest-hspec+  default-language: Haskell2010

@@ -0,0 +1,10 @@+module Main where++import Spec+import Test.Syd+import Test.Syd.OptParse++main :: IO ()+main = do+  _ <- sydTestResult defaultSettings spec+  pure ()

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover -optF --no-main #-}

@@ -0,0 +1,16 @@+module Test.Syd.HspecSpec (spec) where++import Test.Hspec as Hspec+import Test.Hspec.QuickCheck as Hspec+import qualified Test.Syd as Syd+import qualified Test.Syd.Hspec as Syd++spec :: Syd.Spec+spec = Syd.fromHspec exampleHspecSpec++exampleHspecSpec :: Hspec.Spec+exampleHspecSpec = do+  it "adds 3 and 5 together purely" $ 3 + 5 == (8 :: Int)+  it "adds 3 and 5 together in io" $ 3 + 5 `shouldBe` (8 :: Int)+  it "fails here" $ 2 + 2 `shouldBe` (5 :: Int)+  prop "works for a property as well" $ \ls -> reverse (reverse ls) `shouldBe` (ls :: [Int])