diff --git a/test/Data/Source/Spec.hs b/test/Data/Source/Spec.hs index 27711cd83c..30ff909af6 100644 --- a/test/Data/Source/Spec.hs +++ b/test/Data/Source/Spec.hs @@ -8,10 +8,9 @@ import qualified Data.Text as Text import Test.Hspec import qualified Generators as Gen +import Hedgehog hiding (Range) import qualified Hedgehog.Gen as Gen -import Hedgehog ((===), label) import qualified Hedgehog.Range -import Hedgehog hiding (Range) import qualified Test.Tasty as Tasty import Test.Tasty.Hedgehog (testProperty) @@ -25,14 +24,12 @@ prop desc f testTree :: Tasty.TestTree testTree = Tasty.testGroup "Data.Source" [ Tasty.testGroup "sourceLineRanges" - [ testProperty "produces 1 more range than there are newlines" $ property $ do - source <- forAll (Gen.source (Hedgehog.Range.linear 0 100)) - label (summarize source) - (length (sourceLineRanges source) === length (Text.splitOn "\r\n" (toText source) >>= Text.splitOn "\r" >>= Text.splitOn "\n")) - - , testProperty "produces exhaustive ranges" $ property $ do - source <- forAll (Gen.source (Hedgehog.Range.linear 0 100)) - label (summarize source) + [ prop "produces 1 more range than there are newlines" $ \ source -> do + summarize source + length (sourceLineRanges source) === length (Text.splitOn "\r\n" (toText source) >>= Text.splitOn "\r" >>= Text.splitOn "\n") + + , prop "produces exhaustive ranges" $ \ source -> do + summarize source foldMap (`slice` source) (sourceLineRanges source) === source ] @@ -72,10 +69,12 @@ testTree = Tasty.testGroup "Data.Source" ] ] - where summarize src = case sourceLines src of - [] -> "empty" - [x] -> if nullSource x then "empty" else "single-line" - _ -> "multiple lines" + where summarize src = do + let lines = sourceLines src + -- FIXME: this should be using cover (reverted in 1b427b995), but that leads to flaky tests: hedgehog’s 'cover' implementation fails tests instead of warning, and currently has no equivalent to 'checkCoverage'. + classify "empty" $ nullSource src + classify "single-line" $ length lines == 1 + classify "multiple lines" $ length lines > 1 spec :: Spec spec = do diff --git a/test/Generators.hs b/test/Generators.hs index d71112c279..55161319db 100644 --- a/test/Generators.hs +++ b/test/Generators.hs @@ -9,4 +9,6 @@ import qualified Data.Source import Data.Functor.Identity source :: (GenBase m ~ Identity, MonadGen m) => Hedgehog.Range Int -> m Data.Source.Source -source r = Data.Source.fromUTF8 <$> Gen.utf8 r (Gen.frequency [ (1, pure '\r'), (1, pure '\n'), (20, Gen.unicode) ]) +source r = Gen.frequency [ (1, empty), (20, nonEmpty) ] + where empty = pure mempty + nonEmpty = Data.Source.fromUTF8 <$> Gen.utf8 r (Gen.frequency [ (1, pure '\r'), (1, pure '\n'), (20, Gen.unicode) ])