coverage (empty) → 0.1.0.0

raw patch · 12 files changed

+727/−0 lines, 12 filesdep +QuickCheckdep +basedep +coveragesetup-changed

Dependencies added: QuickCheck, base, coverage, hspec

Files

• LICENSE +20/−0
• README.md +19/−0
• Setup.hs +2/−0
• coverage.cabal +50/−0
• examples/Nat.hs +60/−0
• examples/Tree.hs +70/−0
• src/Coverage.hs +50/−0
• src/Coverage/Internal.hs +210/−0
• tests/CoverageSpec.hs +49/−0
• tests/CoverageSupport.hs +66/−0
• tests/CoverageUnitSpec.hs +128/−0
• tests/Spec.hs +3/−0

@@ -0,0 +1,20 @@+Copyright (c) 2015 Nicolas Del Piano++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

@@ -0,0 +1,19 @@+## Coverage++### An exhaustivity checking library++Copyright 2015, Nicolas Del Piano <ndel314@gmail.com>.++This package provides a tool that performs exhaustivity and redundancy checking over custom pattern matching definitions.++Installation:++    cabal install exhaustive++You can see examples of usage in the `examples` directory and read the Haddock documentation.++#### Tests++For running tests (in the `tests` directory):++    runhaskell Spec.hs

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,50 @@+name:                coverage+version:             0.1.0.0+synopsis:            Exhaustivity Checking Library+homepage:            https://github.com/nicodelpiano/coverage+bug-reports:         https://github.com/nicodelpiano/coverage/issues+description:         A library for exhaustivity and redundancy checking.+license:             MIT+license-file:        LICENSE+author:              Nicolas Del Piano <ndel314@gmail.com>+maintainer:          Nicolas Del Piano <ndel314@gmail.com>+copyright:           (c) 2015 Nicolas Del Piano+category:            Development+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++extra-source-files:+  examples/*.hs+  tests/*.hs++source-repository head+    type: git+    location: https://github.com/nicodelpiano/coverage.git++library+  ghc-options:         -Wall+  exposed-modules:     Coverage+                       Coverage.Internal+  -- other-modules:+  -- other-extensions:+  build-depends:       base >=4.7 && <4.8+  hs-source-dirs:      src+  default-language:    Haskell2010++test-suite tests+  type:+      exitcode-stdio-1.0+  ghc-options:+      -Wall+  hs-source-dirs:+      tests, .+  main-is:+      Spec.hs+  other-modules:+      CoverageSpec+      CoverageSupport+      CoverageUnitSpec+  build-depends:+      base >=4.7 && <4.8, coverage, QuickCheck >=2.7, hspec   == 2.*+  default-language:    Haskell2010

@@ -0,0 +1,60 @@+-----------------------------------------------------------------------------+--+-- Module      :  Nat+-- Copyright   :  (c) 2015 Nicolas Del Piano+-- License     :  MIT+--+-- Maintainer  :  Nicolas Del Piano <ndel314@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Example using nats. +--+-----------------------------------------------------------------------------++module Nat where++import Coverage++import Control.Arrow (first, second)++-- | Nat+data Nat = Z | S Nat+  deriving (Show, Eq)++-- | Name binding association+data NatBinder = NullBinder       -- Wildcard binder+               | Zero             -- Zero binder+               | Succ NatBinder   -- Succ binder+  deriving (Show, Eq)++natToBinder :: NatBinder -> Binder NatBinder+natToBinder NullBinder = Var Nothing+natToBinder Zero = Tagged "Zero" $ Var Nothing+natToBinder (Succ nb) = Tagged "Succ" $ natToBinder nb++binderToNat :: Binder NatBinder -> NatBinder+binderToNat (Var Nothing) = NullBinder+binderToNat (Tagged "Zero" _) = Zero+binderToNat (Tagged "Succ" b) = Succ $ binderToNat b+binderToNat _ = error "The given binder is not valid."++env :: String -> Maybe [String]+env "Zero" = Just $+  ["Zero", "Succ"]+env "Succ" = Just $+  ["Zero", "Succ"]+env _ = error "The given name is not a valid constructor."++checkNat :: [([NatBinder], Maybe Guard)] -> ([[NatBinder]], [[NatBinder]])+checkNat def =+  let ch = check (makeEnv env) toBinder+  in (map fromBinder $ getUncovered ch, map fromBinder $ fromRedundant $ getRedundant ch)+  where+  toBinder = map (\(nbs, g) -> (map natToBinder nbs, g)) def++  fromBinder = map binderToNat++  fromRedundant (NotRedundant bs) = bs+  fromRedundant _ = []

@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+--+-- Module      :  Tree+-- Copyright   :  (c) 2015 Nicolas Del Piano+-- License     :  MIT+--+-- Maintainer  :  Nicolas Del Piano <ndel314@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Example using trees.+--+-----------------------------------------------------------------------------++module Tree where++import Coverage++import Control.Arrow (first, second)++-- | Tree data-type+data Tree a = E+            | L a+            | B (Tree a) (Tree a)+  deriving (Show, Eq)++-- | Tree binders+data TreeBinder a = NullBinder+                  | Empty+                  | Leaf a+                  | Branch (TreeBinder a) (TreeBinder a)+  deriving (Show, Eq)++treeToBinder :: (Eq a) => TreeBinder a -> Binder a+treeToBinder NullBinder = Var Nothing+treeToBinder Empty = Tagged "Empty" $ Var Nothing+treeToBinder (Leaf l) = Tagged "Leaf" $ Lit l+treeToBinder (Branch l r) = Tagged "Branch" $ Product [treeToBinder l, treeToBinder r]++binderToTree :: (Eq a) => Binder a -> TreeBinder (Maybe a)+binderToTree (Var Nothing) = NullBinder+binderToTree (Tagged "Empty" _) = Empty+binderToTree (Tagged "Leaf" (Lit l)) = Leaf $ Just l+binderToTree (Tagged "Leaf" (Var _)) = Leaf Nothing+binderToTree (Tagged "Branch" (Var _)) = Branch NullBinder NullBinder+binderToTree (Tagged "Branch" (Product [l, r])) = Branch (binderToTree l) (binderToTree r)+binderToTree _ = error "The given binder is not valid."++env :: String -> Maybe [String]+env = go+  where+  maps = Just ["Empty", "Leaf", "Branch"]++  go "Empty" = maps+  go "Leaf" = maps+  go "Branch" = maps+  go _ = error "The given name is not a valid constructor."++checkTree :: (Eq a) => [([TreeBinder a], Maybe Guard)] -> ([[TreeBinder (Maybe a)]], [[TreeBinder (Maybe a)]])+checkTree def =+  let ch = check (makeEnv env) toBinder+  in (map fromBinder $ getUncovered ch, map fromBinder $ fromRedundant $ getRedundant ch)+  where+  toBinder = map (\(nbs, g) -> (map treeToBinder nbs, g)) def++  fromBinder = map binderToTree++  fromRedundant (NotRedundant bs) = bs+  fromRedundant _ = []

@@ -0,0 +1,50 @@+-----------------------------------------------------------------------------+--+-- Module      :  Coverage+-- Copyright   :  (c) 2015 Nicolas Del Piano+-- License     :  MIT+--+-- Maintainer  :  Nicolas Del Piano <ndel314@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Exhaustivity checking main function.+--+-----------------------------------------------------------------------------++module Coverage+  ( check+  , Binder(..)+  , Guard(..)+  , makeEnv+  , Check(..)+  , Redundant(..)+  ) where++import Coverage.Internal++import Data.List (foldl', nub)+import Data.Maybe (fromMaybe)++import Control.Applicative ((<$>), liftA2)++-- |+-- Given a list of alternatives, `check` generates the proper set of uncovered cases.+--+check :: (Eq lit) => Environment -> [Alternative lit] -> Check lit+check env cas = applyRedundant (fmap nub) . applyUncovered nub . foldl' step initial $ cas+  where+  initial = makeCheck [initialize $ length . fst . head $ cas] $ NotRedundant []++  step :: (Eq lit) => Check lit -> Alternative lit -> Check lit+  step ch ca =+    let (missed, pr) = unzip $ map (missingAlternative env ca) $ getUncovered ch+        cond = liftA2 (&&) (or <$> sequence pr) $ mr . getRedundant $ ch+    in applyRedundant (\_ -> if fromMaybe True cond then getRedundant ch else fmap (fst ca :) $ getRedundant ch)+       . applyUncovered (\unc -> if fromMaybe True cond then concat missed else unc) $ ch+      where+      mr :: Redundant [Binders lit] -> Maybe Bool+      mr DontKnow = Nothing+      mr Redundant = Just False+      mr (NotRedundant _) = Just True

@@ -0,0 +1,210 @@+-----------------------------------------------------------------------------+--+-- Module      :  Coverage.Internal+-- Copyright   :  (c) 2015 Nicolas Del Piano+-- License     :  MIT+--+-- Maintainer  :  Nicolas Del Piano <ndel314@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Module for internal representation.+--+-----------------------------------------------------------------------------++module Coverage.Internal where++import Data.List (sortBy)+import Data.Function (on)+import Data.Maybe (fromMaybe)++import Control.Applicative (Applicative, (<*>), pure, liftA2)+import Control.Arrow (first)++-- | A type synonym for names. +type Name = String++-- | A collection of binders, as used to match products, in product binders+-- or collections of binders in top-level declarations.+type Binders lit = [Binder lit]++-- |+-- Binders+--+data Binder lit+  = Var (Maybe Name)+  | Lit lit+  | Tagged Name (Binder lit)+  | Product (Binders lit)+  | Record [(Name, Binder lit)]+  deriving (Show, Eq)++-- | Environment+--+-- The language implementor should provide an environment to let+-- the checker lookup for constructors' names (just for one type for now).+newtype Environment = Environment { envInfo :: Name -> Maybe [Name] }++makeEnv :: (Name -> Maybe [Name]) -> Environment+makeEnv info = Environment { envInfo = info }++defaultEnv :: Environment+defaultEnv = makeEnv (\_ -> Nothing)++-- | Guards and alternatives+-- +-- Guard are abstract, and it is up to the language implementor to interpret+-- guards abstractly. Guards can catch all cases, or represent some opaque+-- expression which cannot be analysed.+data Guard = CatchAll | Opaque+  deriving (Show, Eq)++-- | A case alternative consists of a collection of binders which match+-- a collection of values, and an optional guard.+type Alternative lit = (Binders lit, Maybe Guard)++-- | Data-type for redundant cases representation.+data Redundant a = DontKnow | Redundant | NotRedundant a+  deriving (Show, Eq)++-- | Functor instance for Redundant (TODO: proofs).+instance Functor Redundant where+  fmap _ DontKnow         = DontKnow+  fmap _ Redundant        = Redundant+  fmap f (NotRedundant r) = NotRedundant $ f r++-- | Applicative instance for Redundant.+instance Applicative Redundant where+  pure = NotRedundant++  DontKnow <*> _         = DontKnow+  Redundant <*> _        = Redundant+  (NotRedundant f) <*> m = fmap f m++-- | Check wraps both uncovered and redundant cases.+data Check lit = Check+  { getUncovered :: [Binders lit]+  , getRedundant :: Redundant [Binders lit]+  } deriving (Show, Eq) ++makeCheck :: [Binders lit] -> Redundant [Binders lit] -> Check lit+makeCheck bs red = Check+  { getUncovered = bs+  , getRedundant = red }++applyUncovered :: ([Binders lit] -> [Binders lit]) -> Check lit -> Check lit+applyUncovered f c = makeCheck (f $ getUncovered c) (getRedundant c)++applyRedundant :: (Redundant [Binders lit] -> Redundant [Binders lit]) -> Check lit -> Check lit+applyRedundant f c = makeCheck (getUncovered c) (f $ getRedundant c)++-- | Wildcard+wildcard :: Binder lit+wildcard = Var Nothing++-- |+-- Applies a function over two lists of tuples that may lack elements.+--+genericMerge :: Ord a =>+  (a -> Maybe b -> Maybe c -> d) ->+  [(a, b)] ->+  [(a, c)] ->+  [d]+genericMerge _ [] [] = []+genericMerge f bs [] = map (\(s, b) -> f s (Just b) Nothing) bs+genericMerge f [] bs = map (\(s, b) -> f s Nothing (Just b)) bs+genericMerge f bsl@((s, b):bs) bsr@((s', b'):bs')+  | s < s' = (f s (Just b) Nothing) : genericMerge f bs bsr+  | s > s' = (f s' Nothing (Just b')) : genericMerge f bsl bs'+  | otherwise = (f s (Just b) (Just b')) : genericMerge f bs bs'++-- | Returns the uncovered set after one binder is applied to the set of+-- values represented by another.+missingSingle :: (Eq lit) => Environment -> Binder lit -> Binder lit -> ([Binder lit], Maybe Bool)+missingSingle _ _ (Var _) = ([], pure True)+missingSingle env (Var _) (Product ps) =+  first (map Product) $ missingMultiple env (initialize $ length ps) ps+missingSingle env p@(Product ps) (Product ps')+  | length ps == length ps' = first (map Product) $ missingMultiple env ps ps'+  | otherwise = ([p], pure False)+missingSingle env (Var _) cb@(Tagged con _) =+  (concatMap (\cp -> fst $ missingSingle env cp cb) $ tagEnv, pure True)+  where+  tag :: (Eq lit) => Name -> Binder lit+  tag n = Tagged n wildcard++  tagEnv :: (Eq lit) => [Binder lit]+  tagEnv = map tag+           . fromMaybe (error $ "Constructor name '" ++ con ++ "' not in the scope of the current environment in missingSingle.")+           . envInfo env $ con+missingSingle env c@(Tagged tag bs) (Tagged tag' bs')+  | tag == tag' = let (bs'', pr) = missingSingle env bs bs' in (map (Tagged tag) bs'', pr)+  | otherwise = ([c], pure False)+missingSingle env (Var _) (Record bs) =+  (map (Record . zip names) $ miss, pr)+  where+  (miss, pr) = missingMultiple env (initialize $ length bs) binders++  (names, binders) = unzip bs+missingSingle env (Record bs) (Record bs') =+  (map (Record . zip sortedNames) $ allMisses, pr)+  where+  (allMisses, pr) = uncurry (missingMultiple env) $ unzip binders++  sortNames = sortBy (compare `on` fst)+  +  (sbs, sbs') = (sortNames bs, sortNames bs')++  compB :: a -> Maybe a -> Maybe a -> (a, a)+  compB e b b' = (fm b, fm b')+    where+    fm = fromMaybe e++  compBS :: Eq a => b -> a -> Maybe b -> Maybe b -> (a, (b, b))+  compBS e s b b' = (s, compB e b b')++  (sortedNames, binders) = unzip $ genericMerge (compBS (Var Nothing)) sbs sbs'+missingSingle _ b@(Lit l) (Lit l')+  | l == l' = ([], pure True)+  | otherwise = ([b], pure False) +missingSingle _ b _ = ([b], Nothing) ++-- |+-- Generates a list of initial binders.+--+initialize :: Int -> [Binder lit]+initialize = flip replicate $ wildcard++-- |+-- `missingMultiple` returns the whole set of uncovered cases.+--+missingMultiple :: (Eq lit) => Environment -> Binders lit -> Binders lit -> ([Binders lit], Maybe Bool)+missingMultiple env = go+  where+  go [] [] = ([], pure True)+  go (x:xs) (y:ys) = (map (: xs) missed ++ fmap (x :) missed', liftA2 (&&) pr1 pr2)+    where+    (missed, pr1) = missingSingle env x y+    (missed', pr2) = go xs ys+  go _ _ = error "Error in missingMultiple: invalid length of argument binders."++-- |+-- `missingCases` applies `missingMultiple` to an alternative.+--+missingCases :: (Eq lit) => Environment -> Binders lit -> Alternative lit -> ([Binders lit], Maybe Bool)+missingCases env unc = missingMultiple env unc . fst++-- |+-- `missingAlternative` is `missingCases` with guard handling.+--+missingAlternative :: (Eq lit) => Environment -> Alternative lit -> Binders lit -> ([Binders lit], Maybe Bool)+missingAlternative env alt unc+  | isExhaustiveGuard $ snd alt = mcases+  | otherwise = ([unc], snd mcases)+  where+  mcases = missingCases env unc alt++  isExhaustiveGuard :: Maybe Guard -> Bool+  isExhaustiveGuard (Just Opaque) = False+  isExhaustiveGuard _ = True

@@ -0,0 +1,49 @@+-----------------------------------------------------------------------------+--+-- Module      :  CoverageSpec+-- Copyright   :  (c) 2015 Nicolas Del Piano+-- License     :  MIT+--+-- Maintainer  :  Nicolas Del Piano <ndel314@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Tests.+--+-----------------------------------------------------------------------------++module CoverageSpec (main, spec) where++import Coverage+import Coverage.Internal+import CoverageSupport++import Test.Hspec+import Test.HUnit+import Test.QuickCheck++import Control.Exception (evaluate)++spec :: Spec+spec = do+  describe "Test suite" $ do+    describe "missingSingle" $ do+      it "between any binder and `Var _` should be `[]`" $+        property $ \b n -> fst (missingSingle defaultEnv (b :: Binder String) (Var n)) == []++      it "between the same binders should be `[]`" $+        property $ \b -> fst (missingSingle defaultEnv (b :: Binder String) b) == []++      it "if we covered something, then uncovered should be `[]`" $+        property $ \b b' ->+          let (unc, cov) = missingSingle defaultEnv (b :: Binder String) (b' :: Binder String)+          in cov == Just True ==> unc == []++      it "if there are no uncovered cases, then we covered something" $+        property $ \b b' ->+          let (unc, cov) = missingSingle defaultEnv (b :: Binder String) (b' :: Binder String)+          in unc == [] ==> cov == Just True++main :: IO ()+main = hspec spec

@@ -0,0 +1,66 @@+-----------------------------------------------------------------------------+--+-- Module      :  CoverageSupport+-- Copyright   :  (c) 2015 Nicolas Del Piano+-- License     :  MIT+--+-- Maintainer  :  Nicolas Del Piano <ndel314@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- QuickCheck instance for Binder data-type.+--+-----------------------------------------------------------------------------+   +module CoverageSupport where++import Coverage.Internal++import Control.Monad (liftM, liftM2, liftM3)++import Test.QuickCheck++-- |+-- Generates a list of binders.+--+genBinders :: (Eq a, Arbitrary a) => Int -> Gen (Binders a)+genBinders 0 = return []+genBinders n = liftM2 (:) arbitrary (genBinders (n-1))++-- |+-- Generates a list of pairs (name, binder).+--+genRec :: (Eq a, Arbitrary a) => Int -> Gen [(Name, Binder a)]+genRec 0 = return []+genRec n = liftM3 (\n b -> (:) (n, b)) arbitrary arbitrary (genRec (n-1))++-- |+-- Specific generators for each type of binder.+--+genVar :: (Eq a, Arbitrary a) => Gen (Binder a)+genVar = liftM Var arbitrary++-- |+-- Although necessary, there are no tests for tagged yet since+-- we need to construct an specific environment.+--+genTagged :: (Eq a, Arbitrary a) => Gen (Binder a)+genTagged = liftM2 Tagged arbitrary arbitrary++genLit :: (Eq a, Arbitrary a) => Gen (Binder a)+genLit = liftM Lit arbitrary++genRecord :: (Eq a, Arbitrary a) => Gen (Binder a)+genRecord = liftM Record (choose (0, 2) >>= genRec)++genProduct :: (Eq a, Arbitrary a) => Gen (Binder a)+genProduct = liftM Product (choose (0, 2) >>= genBinders)++instance (Eq a, Arbitrary a) => Arbitrary (Binder a) where+  arbitrary = oneof+    [ genVar+    , genLit+    , genProduct+    , genRecord+    ]

@@ -0,0 +1,128 @@+-----------------------------------------------------------------------------+--+-- Module      :  CoverageUnitSpec+-- Copyright   :  (c) 2015 Nicolas Del Piano+-- License     :  MIT+--+-- Maintainer  :  Nicolas Del Piano <ndel314@gmail.com>+-- Stability   :  experimental+-- Portability :+--+-- |+-- Unit tests.+--+-----------------------------------------------------------------------------++module CoverageUnitSpec (main, spec) where++import Coverage+import Coverage.Internal+import CoverageSupport++import Test.Hspec+import Test.HUnit+import Test.QuickCheck++import Control.Exception (evaluate)++env :: Environment+env = makeEnv env'+  where+  env' :: String -> Maybe [String]+  env' "Zero" = Just $+    ["Zero", "Succ"]+  env' "Succ" = Just $+    ["Zero", "Succ"]+  env' _ = error "The given name is not a valid constructor."++z :: Binder ()+z = Tagged "Zero" wildcard++s :: Binder () -> Binder ()+s b = Tagged "Succ" b++tagged_def1 :: [Alternative ()]+tagged_def1 = [([z], Nothing)]++tagged_def2 :: [Alternative ()]+tagged_def2 = [([z], Nothing),([s wildcard], Nothing)]++tagged_def3 :: [Alternative ()]+tagged_def3 = [([z, z], Nothing)]++tagged_def4 :: [Alternative ()]+tagged_def4 = [([z, z], Nothing), ([wildcard, wildcard], Nothing)]++tagged_def5 :: [Alternative ()]+tagged_def5 = [([wildcard], Nothing), ([z], Nothing)]++tagged_def6 :: [Alternative ()]+tagged_def6 = [([wildcard, wildcard, wildcard], Nothing), ([z, z, z], Nothing)]++fromRedundant (NotRedundant bs) = bs+fromRedundant _ = []++lit_def1 :: [Alternative String]+lit_def1 = [([Lit "hello"], Nothing)]++record_def1 :: [Alternative ()]+record_def1 = [([Record [("foo", wildcard)]], Nothing)]++record_def2 :: [Alternative ()]+record_def2 = [([Record [("foo", z)]], Nothing), ([Record [("bar", z), ("foo", s z)]], Nothing)]++product_def1 :: [Alternative ()]+product_def1 = [([Product []], Nothing)]++product_def2 :: [Alternative ()]+product_def2 = [([Product [z, z]], Nothing)]++spec :: Spec+spec = do+  describe "Unit tests" $ do++    describe "Literals" $ do+      it "lit_def1 is not exhaustive" $ do+        (getUncovered $ check defaultEnv lit_def1) `shouldBe` [[wildcard]]++      it "lit_def1 has redundant cases" $ do+        (getUncovered $ check defaultEnv lit_def1) `shouldBe` [[wildcard]]++    describe "Tagged" $ do+      it "tagged_def1 is not exhaustive" $ do+        (getUncovered $ check env tagged_def1) `shouldBe` [[s wildcard]]++      it "tagged_def1 has not redundant cases" $ do+        (fromRedundant $ getRedundant $ check env tagged_def1) `shouldBe` []++      it "tagged_def2 is exhaustive" $ do+        (getUncovered $ check env tagged_def2) `shouldBe` []++      it "tagged_def3 is not exhaustive" $ do+        (getUncovered $ check env tagged_def3) `shouldBe` [[s wildcard, wildcard], [wildcard, s wildcard]]++      it "tagged_def4 is exhaustive" $ do+        (getUncovered $ check env tagged_def4) `shouldBe` []++      it "tagged_def5 has redundant cases" $ do+        (fromRedundant $ getRedundant $ check env tagged_def5) `shouldBe` [[z]]++      it "tagged_def6 has redundant cases" $ do+        (fromRedundant $ getRedundant $ check env tagged_def6) `shouldBe` [[z, z, z]]++    describe "Record" $ do+      it "record_def1 is exhaustive" $ do+        (getUncovered $ check env record_def1) `shouldBe` []+ +      it "record_def2 is not exhaustive" $ do+        (getUncovered $ check env record_def2) `shouldBe` [[Record [("bar", s wildcard), ("foo", s wildcard)]], [Record [("bar", wildcard),("foo", s $ s wildcard)]]]++    describe "Product" $ do+      it "product_def1 is exhaustive" $ do+        (getUncovered $ check env record_def1) `shouldBe` []++      it "product_def2 is not exhaustive" $ do+        (getUncovered $ check env record_def1) `shouldBe` []++main :: IO ()+main = hspec spec

@@ -0,0 +1,3 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}++import Exhaustive.Internal