Merge pull request #222 from github/source-coverage-guarantees

Source coverage “guarantees”

Author: Patrick Thomson

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

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) ])