explainable-predicates (empty) → 0.1.0.0

raw patch · 10 files changed

+2648/−0 lines, 10 filesdep +arraydep +basedep +doctest-exitcode-stdio

Dependencies added: array, base, doctest-exitcode-stdio, doctest-lib, explainable-predicates, hspec, mono-traversable, regex-tdfa, syb, template-haskell

Files

• CHANGELOG.md +5/−0
• LICENSE +30/−0
• explainable-predicates.cabal +56/−0
• src/Test/Predicates.hs +1312/−0
• src/Test/Predicates/Internal/FlowMatcher.hs +95/−0
• src/Test/Predicates/Internal/Util.hs +47/−0
• test/DocTests/All.hs +12/−0
• test/DocTests/Test/Predicates.hs +928/−0
• test/DocTests/Test/Predicates/Internal/FlowMatcher.hs +20/−0
• test/Main.hs +143/−0

@@ -0,0 +1,5 @@+# Revision history for explainable-predicates++## 0.1.0.0 -- 2021-09-18++* First version. Released on an unsuspecting world.

@@ -0,0 +1,30 @@+Copyright (c) 2021, Chris Smith++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Chris Smith nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,56 @@+cabal-version:      2.4+name:               explainable-predicates+version:            0.1.0.0+synopsis:           Predicates that can explain themselves.+description:        Explainable predicates are essentially functions from types+                    to 'Bool' which can additionally describe themselves and+                    explain why an argument does or doesn't match.  They are+                    intended to be used during unit tests to provide better+                    error messages when tests fail.  For example, if a+                    collection is missing an element, an explainable predicate+                    can tell you which element is missing.+category:           Testing+homepage:           https://github.com/cdsmith/explainable-predicates+bug-reports:        https://github.com/cdsmith/explainable-predicates/issues+license:            BSD-3-Clause+license-file:       LICENSE++author:             Chris Smith <cdsmith@gmail.com>+maintainer:         Chris Smith <cdsmith@gmail.com>++extra-source-files: CHANGELOG.md++tested-with:        GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1++source-repository head+    type:     git+    location: git://github.com/cdsmith/explainable-predicates.git++library+    exposed-modules:  Test.Predicates,+                      Test.Predicates.Internal.FlowMatcher+    other-modules:    Test.Predicates.Internal.Util+    build-depends:    array >= 0.5.2 && < 0.6,+                      base >=4.11.0 && < 4.16,+                      mono-traversable >= 1.0.15 && < 1.1,+                      regex-tdfa >= 1.3.1 && < 1.4,+                      syb >= 0.7.2 && < 0.8,+                      template-haskell >= 2.13.0 && < 2.18,+    hs-source-dirs:   src+    default-language: Haskell2010+    ghc-options:      -Wall -Wcompat -Wincomplete-uni-patterns++test-suite tests+    type:             exitcode-stdio-1.0+    main-is:          Main.hs+    other-modules:    DocTests.All,+                      DocTests.Test.Predicates,+                      DocTests.Test.Predicates.Internal.FlowMatcher+    build-depends:    base,+                      doctest-exitcode-stdio,+                      doctest-lib,+                      explainable-predicates,+                      hspec,+    hs-source-dirs:   test+    default-language: Haskell2010+    ghc-options:      -threaded -Wall -Wcompat -Wincomplete-uni-patterns

@@ -0,0 +1,1312 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ParallelListComp #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}++-- | Explainable 'Predicate's are essentially functions from types to `Bool`+-- which can additionally describe themselves and explain why an argument does+-- or doesn't match.  They are intended to be used during unit tests to provide+-- better error messages when tests fail.+module Test.Predicates+  ( -- * The Predicate type+    Predicate (..),++    -- * Predicate combinators+    anything,+    eq,+    neq,+    gt,+    geq,+    lt,+    leq,+    just,+    nothing,+    left,+    right,+    zipP,+    zip3P,+    zip4P,+    zip5P,+    andP,+    orP,+    notP,+    startsWith,+    endsWith,+    hasSubstr,+    hasSubsequence,+    caseInsensitive,+    matchesRegex,+    matchesCaseInsensitiveRegex,+    containsRegex,+    containsCaseInsensitiveRegex,+    isEmpty,+    nonEmpty,+    sizeIs,+    elemsAre,+    unorderedElemsAre,+    each,+    contains,+    containsAll,+    containsOnly,+    keys,+    values,+    approxEq,+    positive,+    negative,+    nonPositive,+    nonNegative,+    finite,+    infinite,+    nAn,+    is,+    qIs,+    with,+    qWith,+    qMatch,+    typed,+  )+where++import Data.Char (toUpper)+import Data.List (intercalate)+import Data.Maybe (catMaybes, isJust, isNothing)+import Data.MonoTraversable (Element, MonoFoldable (..), MonoFunctor (..))+import qualified Data.Sequences as Seq+import Data.Typeable (Proxy (..), Typeable, cast, typeRep)+import GHC.Exts (IsList (Item, toList))+import GHC.Stack (HasCallStack, callStack)+import Language.Haskell.TH (ExpQ, PatQ, pprint)+import Language.Haskell.TH.Syntax (lift)+import Test.Predicates.Internal.FlowMatcher (bipartiteMatching)+import Test.Predicates.Internal.Util+  ( isSubsequenceOf,+    locate,+    removeModNames,+    withLoc,+  )+import Text.Regex.TDFA+  ( CompOption (caseSensitive, lastStarGreedy, newSyntax),+    ExecOption (captureGroups),+    Extract (empty),+    Regex,+    RegexLike (matchOnce, matchOnceText),+    RegexMaker (makeRegexOpts),+    RegexOptions (defaultCompOpt, defaultExecOpt),+  )++-- $setup+-- >>> :set -XTemplateHaskell+-- >>> :set -XTypeApplications+-- >>> :set -Wno-type-defaults++-- | A predicate, which tests values and either accepts or rejects them.  This+-- is similar to @a -> 'Bool'@, but also can describe itself and explain why an+-- argument does or doesn't match.+data Predicate a = Predicate+  { showPredicate :: String,+    showNegation :: String,+    accept :: a -> Bool,+    explain :: a -> String+  }++instance Show (Predicate a) where show = showPredicate++withDefaultExplain ::+  (a -> String) -> String -> ((a -> String) -> Predicate a) -> Predicate a+withDefaultExplain format connector mk = p+  where+    p = mk $ \x ->+      if accept p x+        then format x ++ connector ++ showPredicate p+        else format x ++ connector ++ showNegation p++-- | A 'Predicate' that accepts anything at all.+--+-- >>> accept anything "foo"+-- True+-- >>> accept anything undefined+-- True+anything :: Predicate a+anything =+  Predicate+    { showPredicate = "anything",+      showNegation = "nothing",+      accept = const True,+      explain = const "always matches"+    }++-- | A 'Predicate' that accepts only the given value.+--+-- >>> accept (eq "foo") "foo"+-- True+-- >>> accept (eq "foo") "bar"+-- False+eq :: (Show a, Eq a) => a -> Predicate a+eq x =+  Predicate+    { showPredicate = show x,+      showNegation = "≠ " ++ show x,+      accept = (== x),+      explain = \y ->+        if y == x+          then show y ++ " = " ++ show x+          else show y ++ " ≠ " ++ show x+    }++-- | A 'Predicate' that accepts anything but the given value.+--+-- >>> accept (neq "foo") "foo"+-- False+-- >>> accept (neq "foo") "bar"+-- True+neq :: (Show a, Eq a) => a -> Predicate a+neq = notP . eq++-- | A 'Predicate' that accepts anything greater than the given value.+--+-- >>> accept (gt 5) 4+-- False+-- >>> accept (gt 5) 5+-- False+-- >>> accept (gt 5) 6+-- True+gt :: (Show a, Ord a) => a -> Predicate a+gt x = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "> " ++ show x,+      showNegation = "≤ " ++ show x,+      accept = (> x),+      explain = explainImpl+    }++-- | A 'Predicate' that accepts anything greater than or equal to the given+-- value.+--+-- >>> accept (geq 5) 4+-- False+-- >>> accept (geq 5) 5+-- True+-- >>> accept (geq 5) 6+-- True+geq :: (Show a, Ord a) => a -> Predicate a+geq x = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "≥ " ++ show x,+      showNegation = "< " ++ show x,+      accept = (>= x),+      explain = explainImpl+    }++-- | A 'Predicate' that accepts anything less than the given value.+--+-- >>> accept (lt 5) 4+-- True+-- >>> accept (lt 5) 5+-- False+-- >>> accept (lt 5) 6+-- False+lt :: (Show a, Ord a) => a -> Predicate a+lt = notP . geq++-- | A 'Predicate' that accepts anything less than or equal to the given value.+--+-- >>> accept (leq 5) 4+-- True+-- >>> accept (leq 5) 5+-- True+-- >>> accept (leq 5) 6+-- False+leq :: (Show a, Ord a) => a -> Predicate a+leq = notP . gt++-- | A 'Predicate' that accepts 'Maybe' values of @'Just' x@, where @x@ matches+-- the given child 'Predicate'.+--+-- >>> accept (just (eq "value")) Nothing+-- False+-- >>> accept (just (eq "value")) (Just "value")+-- True+-- >>> accept (just (eq "value")) (Just "wrong value")+-- False+just :: Predicate a -> Predicate (Maybe a)+just p =+  Predicate+    { showPredicate = "Just (" ++ showPredicate p ++ ")",+      showNegation = "not Just (" ++ showPredicate p ++ ")",+      accept = \case Just x -> accept p x; _ -> False,+      explain = \case Just x -> explain p x; _ -> "Nothing ≠ Just _"+    }++-- | A Predicate that accepts 'Maybe' values of @'Nothing'@.  Unlike 'eq', this+-- doesn't require 'Eq' or 'Show' instances.+--+-- >>> accept nothing Nothing+-- True+--+-- >>> accept nothing (Just "something")+-- False+nothing :: Predicate (Maybe a)+nothing =+  Predicate+    { showPredicate = "Nothing",+      showNegation = "Just anything",+      accept = isNothing,+      explain = \case Nothing -> "Nothing = Nothing"; _ -> "Just _ ≠ Nothing"+    }++-- | A 'Predicate' that accepts an 'Either' value of @'Left' x@, where @x@+-- matches the given child 'Predicate'.+--+-- >>> accept (left (eq "value")) (Left "value")+-- True+-- >>> accept (left (eq "value")) (Right "value")+-- False+-- >>> accept (left (eq "value")) (Left "wrong value")+-- False+left :: Predicate a -> Predicate (Either a b)+left p =+  Predicate+    { showPredicate = "Left (" ++ showPredicate p ++ ")",+      showNegation = "not Left (" ++ showPredicate p ++ ")",+      accept = \case Left x -> accept p x; _ -> False,+      explain = \case Left x -> explain p x; _ -> "Right _ ≠ Left _"+    }++-- | A 'Predicate' that accepts an 'Either' value of @'Right' x@, where @x@+-- matches the given child 'Predicate'.+--+-- >>> accept (right (eq "value")) (Right "value")+-- True+-- >>> accept (right (eq "value")) (Right "wrong value")+-- False+-- >>> accept (right (eq "value")) (Left "value")+-- False+right :: Predicate b -> Predicate (Either a b)+right p =+  Predicate+    { showPredicate = "Right (" ++ showPredicate p ++ ")",+      showNegation = "not Right (" ++ showPredicate p ++ ")",+      accept = \case Right x -> accept p x; _ -> False,+      explain = \case Right x -> explain p x; _ -> "Left _ ≠ Right _"+    }++-- | A 'Predicate' that accepts pairs whose elements satisfy the corresponding+-- child 'Predicate's.+--+-- >>> accept (zipP (eq "foo") (eq "bar")) ("foo", "bar")+-- True+-- >>> accept (zipP (eq "foo") (eq "bar")) ("bar", "foo")+-- False+zipP :: Predicate a -> Predicate b -> Predicate (a, b)+zipP p1 p2 =+  Predicate+    { showPredicate = show (p1, p2),+      showNegation = "not " ++ show (p1, p2),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant+    }+  where+    acceptAndExplain = \(x1, x2) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2)+      ]++-- | A 'Predicate' that accepts 3-tuples whose elements satisfy the+-- corresponding child 'Predicate's.+--+-- >>> accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("foo", "bar", "qux")+-- True+-- >>> accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("qux", "bar", "foo")+-- False+zip3P :: Predicate a -> Predicate b -> Predicate c -> Predicate (a, b, c)+zip3P p1 p2 p3 =+  Predicate+    { showPredicate = show (p1, p2, p3),+      showNegation = "not " ++ show (p1, p2, p3),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant+    }+  where+    acceptAndExplain = \(x1, x2, x3) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2),+        (accept p3 x3, explain p3 x3)+      ]++-- | A 'Predicate' that accepts 3-tuples whose elements satisfy the+-- corresponding child 'Predicate's.+--+-- >>> accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (1, 2, 3, 4)+-- True+-- >>> accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (4, 3, 2, 1)+-- False+zip4P ::+  Predicate a ->+  Predicate b ->+  Predicate c ->+  Predicate d ->+  Predicate (a, b, c, d)+zip4P p1 p2 p3 p4 =+  Predicate+    { showPredicate = show (p1, p2, p3, p4),+      showNegation = "not " ++ show (p1, p2, p3, p4),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant+    }+  where+    acceptAndExplain = \(x1, x2, x3, x4) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2),+        (accept p3 x3, explain p3 x3),+        (accept p4 x4, explain p4 x4)+      ]++-- | A 'Predicate' that accepts 3-tuples whose elements satisfy the+-- corresponding child 'Predicate's.+--+-- >>> accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (1, 2, 3, 4, 5)+-- True+-- >>> accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (5, 4, 3, 2, 1)+-- False+zip5P ::+  Predicate a ->+  Predicate b ->+  Predicate c ->+  Predicate d ->+  Predicate e ->+  Predicate (a, b, c, d, e)+zip5P p1 p2 p3 p4 p5 =+  Predicate+    { showPredicate = show (p1, p2, p3, p4, p5),+      showNegation = "not " ++ show (p1, p2, p3, p4, p5),+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            significant+              | all fst results = results+              | otherwise = filter (not . fst) results+         in intercalate " and " $ map snd significant+    }+  where+    acceptAndExplain = \(x1, x2, x3, x4, x5) ->+      [ (accept p1 x1, explain p1 x1),+        (accept p2 x2, explain p2 x2),+        (accept p3 x3, explain p3 x3),+        (accept p4 x4, explain p4 x4),+        (accept p5 x5, explain p5 x5)+      ]++-- | A 'Predicate' that accepts anything accepted by both of its children.+--+-- >>> accept (lt "foo" `andP` gt "bar") "eta"+-- True+-- >>> accept (lt "foo" `andP` gt "bar") "quz"+-- False+-- >>> accept (lt "foo" `andP` gt "bar") "alpha"+-- False+andP :: Predicate a -> Predicate a -> Predicate a+p `andP` q =+  Predicate+    { showPredicate = showPredicate p ++ " and " ++ showPredicate q,+      showNegation = showNegation p ++ " or " ++ showNegation q,+      accept = \x -> accept p x && accept q x,+      explain = \x ->+        if+            | not (accept p x) -> explain p x+            | not (accept q x) -> explain q x+            | otherwise -> explain p x ++ " and " ++ explain q x+    }++-- | A 'Predicate' that accepts anything accepted by either of its children.+--+-- >>> accept (lt "bar" `orP` gt "foo") "eta"+-- False+-- >>> accept (lt "bar" `orP` gt "foo") "quz"+-- True+-- >>> accept (lt "bar" `orP` gt "foo") "alpha"+-- True+orP :: Predicate a -> Predicate a -> Predicate a+p `orP` q = notP (notP p `andP` notP q)++-- | A 'Predicate' that inverts another 'Predicate', accepting whatever its+-- child rejects, and rejecting whatever its child accepts.+--+-- >>> accept (notP (eq "negative")) "positive"+-- True+-- >>> accept (notP (eq "negative")) "negative"+-- False+notP :: Predicate a -> Predicate a+notP p =+  Predicate+    { showPredicate = showNegation p,+      showNegation = showPredicate p,+      accept = not . accept p,+      explain = explain p+    }++-- | A 'Predicate' that accepts sequences that start with the given prefix.+--+-- >>> accept (startsWith "fun") "fungible"+-- True+-- >>> accept (startsWith "gib") "fungible"+-- False+startsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t+startsWith pfx = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "starts with " ++ show pfx,+      showNegation = "doesn't start with " ++ show pfx,+      accept = (pfx `Seq.isPrefixOf`),+      explain = explainImpl+    }++-- | A 'Predicate' that accepts sequences that end with the given suffix.+--+-- >>> accept (endsWith "ow") "crossbow"+-- True+-- >>> accept (endsWith "ow") "trebuchet"+-- False+endsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t+endsWith sfx = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "ends with " ++ show sfx,+      showNegation = "doesn't end with " ++ show sfx,+      accept = (sfx `Seq.isSuffixOf`),+      explain = explainImpl+    }++-- | A 'Predicate' that accepts sequences that contain the given (consecutive)+-- substring.+--+-- >>> accept (hasSubstr "i") "team"+-- False+-- >>> accept (hasSubstr "i") "partnership"+-- True+hasSubstr :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t+hasSubstr s = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "has substring " ++ show s,+      showNegation = "doesn't have substring " ++ show s,+      accept = (s `Seq.isInfixOf`),+      explain = explainImpl+    }++-- | A 'Predicate' that accepts sequences that contain the given (not+-- necessarily consecutive) subsequence.+--+-- >>> accept (hasSubsequence [1..5]) [1, 2, 3, 4, 5]+-- True+-- >>> accept (hasSubsequence [1..5]) [0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0]+-- True+-- >>> accept (hasSubsequence [1..5]) [2, 3, 5, 7, 11]+-- False+hasSubsequence :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t+hasSubsequence s = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "has subsequence " ++ show s,+      showNegation = "doesn't have subsequence " ++ show s,+      accept = (s `isSubsequenceOf`),+      explain = explainImpl+    }++-- | Transforms a 'Predicate' on 'String's or string-like types to match without+-- regard to case.+--+-- >>> accept (caseInsensitive startsWith "foo") "FOOTBALL!"+-- True+-- >>> accept (caseInsensitive endsWith "ball") "soccer"+-- False+-- >>> accept (caseInsensitive eq "time") "TIME"+-- True+-- >>> accept (caseInsensitive gt "NOTHING") "everything"+-- False+caseInsensitive ::+  ( MonoFunctor t,+    MonoFunctor a,+    Element t ~ Char,+    Element a ~ Char+  ) =>+  (t -> Predicate a) ->+  (t -> Predicate a)+caseInsensitive p s =+  Predicate+    { showPredicate = "(case insensitive) " ++ show (p s),+      showNegation = "(case insensitive) " ++ show (notP (p s)),+      accept = accept capP . omap toUpper,+      explain = explain capP . omap toUpper+    }+  where+    capP = p (omap toUpper s)++-- | A 'Predicate' that accepts 'String's or string-like values matching a+-- regular expression.  The expression must match the entire argument.+--+-- You should not use @'caseInsensitive' 'matchesRegex'@, because regular+-- expression syntax itself is still case-sensitive even when the text you are+-- matching is not.  Instead, use 'matchesCaseInsensitiveRegex'.+--+-- >>> accept (matchesRegex "x{2,5}y?") "xxxy"+-- True+-- >>> accept (matchesRegex "x{2,5}y?") "xyy"+-- False+-- >>> accept (matchesRegex "x{2,5}y?") "wxxxyz"+-- False+matchesRegex :: (RegexLike Regex a, Eq a, Show a) => String -> Predicate a+matchesRegex s =+  Predicate+    { showPredicate = pat,+      showNegation = "not " ++ pat,+      accept = accepts,+      explain = \x ->+        if accepts x+          then show x ++ " matches " ++ pat+          else show x ++ " doesn't match " ++ pat+    }+  where+    pat = "/" ++ init (tail $ show s) ++ "/"+    accepts x = case matchOnceText r x of+      Just (a, _, b) -> a == empty && b == empty+      Nothing -> False+    r = makeRegexOpts comp exec s :: Regex+    comp = defaultCompOpt {newSyntax = True, lastStarGreedy = True}+    exec = defaultExecOpt {captureGroups = False}++-- | A 'Predicate' that accepts 'String's or string-like values matching a+-- regular expression in a case-insensitive way.  The expression must match the+-- entire argument.+--+-- You should use this instead of @'caseInsensitive' 'matchesRegex'@, because+-- regular expression syntax itself is still case-sensitive even when the text+-- you are matching is not.+--+-- >>> accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XXXY"+-- True+-- >>> accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XYY"+-- False+-- >>> accept (matchesCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ"+-- False+matchesCaseInsensitiveRegex ::+  (RegexLike Regex a, Eq a, Show a) => String -> Predicate a+matchesCaseInsensitiveRegex s =+  Predicate+    { showPredicate = pat,+      showNegation = "not " ++ pat,+      accept = accepts,+      explain = \x ->+        if accepts x+          then show x ++ " matches " ++ pat+          else show x ++ " doesn't match " ++ pat+    }+  where+    pat = "/" ++ init (tail $ show s) ++ "/i"+    accepts x = case matchOnceText r x of+      Just (a, _, b) -> a == empty && b == empty+      Nothing -> False+    r = makeRegexOpts comp exec s :: Regex+    comp =+      defaultCompOpt+        { newSyntax = True,+          lastStarGreedy = True,+          caseSensitive = False+        }+    exec = defaultExecOpt {captureGroups = False}++-- | A 'Predicate' that accepts 'String's or string-like values containing a+-- match for a regular expression.  The expression need not match the entire+-- argument.+--+-- You should not use @'caseInsensitive' 'containsRegex'@, because regular+-- expression syntax itself is still case-sensitive even when the text you are+-- matching is not.  Instead, use 'containsCaseInsensitiveRegex'.+--+-- >>> accept (containsRegex "x{2,5}y?") "xxxy"+-- True+-- >>> accept (containsRegex "x{2,5}y?") "xyy"+-- False+-- >>> accept (containsRegex "x{2,5}y?") "wxxxyz"+-- True+containsRegex :: (RegexLike Regex a, Eq a, Show a) => String -> Predicate a+containsRegex s = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "contains " ++ pat,+      showNegation = "doesn't contain " ++ pat,+      accept = isJust . matchOnce r,+      explain = explainImpl+    }+  where+    pat = "/" ++ init (tail $ show s) ++ "/"+    r = makeRegexOpts comp exec s :: Regex+    comp = defaultCompOpt {newSyntax = True, lastStarGreedy = True}+    exec = defaultExecOpt {captureGroups = False}++-- | A 'Predicate' that accepts 'String's or string-like values containing a+-- match for a regular expression in a case-insensitive way.  The expression+-- need match the entire argument.+--+-- You should use this instead of @'caseInsensitive' 'containsRegex'@, because+-- regular expression syntax itself is still case-sensitive even when the text+-- you are matching is not.+--+-- >>> accept (containsCaseInsensitiveRegex "x{2,5}y?") "XXXY"+-- True+-- >>> accept (containsCaseInsensitiveRegex "x{2,5}y?") "XYY"+-- False+-- >>> accept (containsCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ"+-- True+containsCaseInsensitiveRegex ::+  (RegexLike Regex a, Eq a, Show a) => String -> Predicate a+containsCaseInsensitiveRegex s = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "contains " ++ pat,+      showNegation = "doesn't contain " ++ pat,+      accept = isJust . matchOnce r,+      explain = explainImpl+    }+  where+    pat = "/" ++ init (tail $ show s) ++ "/i"+    r = makeRegexOpts comp exec s :: Regex+    comp =+      defaultCompOpt+        { newSyntax = True,+          lastStarGreedy = True,+          caseSensitive = False+        }+    exec = defaultExecOpt {captureGroups = False}++-- | A 'Predicate' that accepts empty data structures.+--+-- >>> accept isEmpty ([] :: [Int])+-- True+-- >>> accept isEmpty [1, 2, 3]+-- False+-- >>> accept isEmpty ""+-- True+-- >>> accept isEmpty "gas tank"+-- False+isEmpty :: (MonoFoldable t, Show t) => Predicate t+isEmpty = withDefaultExplain show " is " $ \explainImpl ->+  Predicate+    { showPredicate = "empty",+      showNegation = "non-empty",+      accept = onull,+      explain = explainImpl+    }++-- | A 'Predicate' that accepts non-empty data structures.+--+-- >>> accept nonEmpty ([] :: [Int])+-- False+-- >>> accept nonEmpty [1, 2, 3]+-- True+-- >>> accept nonEmpty ""+-- False+-- >>> accept nonEmpty "gas tank"+-- True+nonEmpty :: (MonoFoldable t, Show t) => Predicate t+nonEmpty = notP isEmpty++-- | A 'Predicate' that accepts data structures whose number of elements match+-- the child 'Predicate'.+--+-- >>> accept (sizeIs (lt 3)) ['a' .. 'f']+-- False+-- >>> accept (sizeIs (lt 3)) ['a' .. 'b']+-- True+sizeIs :: (MonoFoldable t, Show t) => Predicate Int -> Predicate t+sizeIs p =+  Predicate+    { showPredicate = "size " ++ showPredicate p,+      showNegation = "size " ++ showNegation p,+      accept = accept p . olength,+      explain = \y ->+        let detail+              | accept p (olength y) = showPredicate p+              | otherwise = showNegation p+            detailStr+              | show (olength y) == detail = ""+              | otherwise = ", which is " ++ detail+         in show y ++ " has size " ++ show (olength y) ++ detailStr+    }++-- | A 'Predicate' that accepts data structures whose contents each match the+-- corresponding 'Predicate' in the given list, in the same order.+--+-- >>> accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4]+-- True+-- >>> accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4, 5]+-- False+-- >>> accept (elemsAre [lt 3, lt 4, lt 5]) [2, 10, 4]+-- False+elemsAre :: MonoFoldable t => [Predicate (Element t)] -> Predicate t+elemsAre ps =+  Predicate+    { showPredicate = show ps,+      showNegation = "not " ++ show ps,+      accept = \xs ->+        olength xs == olength ps+          && and (zipWith accept ps (otoList xs)),+      explain = \xs ->+        let results = acceptAndExplain (otoList xs)+         in if+                | olength xs /= length ps ->+                  "wrong size (got "+                    ++ show (olength xs)+                    ++ "; expected "+                    ++ show (length ps)+                    ++ ")"+                | all fst results -> "elements are " ++ show ps+                | otherwise ->+                  intercalate "; and " $+                    snd <$> filter (not . fst) results+    }+  where+    acceptAndExplain xs = zipWith3 matchAndExplain [1 :: Int ..] ps xs+    matchAndExplain i p x =+      (accept p x, "in element #" ++ show i ++ ": " ++ explain p x)++-- | A 'Predicate' that accepts data structures whose contents each match the+-- corresponding 'Predicate' in the given list, in any order.+--+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3]+-- True+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [2, 3, 1]+-- True+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3, 4]+-- False+-- >>> accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 3]+-- False+unorderedElemsAre :: MonoFoldable t => [Predicate (Element t)] -> Predicate t+unorderedElemsAre ps =+  Predicate+    { showPredicate =+        "(any order) " ++ show ps,+      showNegation =+        "not (in any order) " ++ show ps,+      accept = \xs ->+        let (_, orphanPs, orphanXs) = matchAll xs+         in null orphanPs && null orphanXs,+      explain = \xs ->+        let (matches, orphanPs, orphanXs) = matchAll xs+         in if null orphanPs && null orphanXs+              then intercalate "; and " (explainMatch <$> matches)+              else+                let missingExplanation =+                      if null orphanPs+                        then Nothing+                        else+                          Just+                            ( "Missing: "+                                ++ intercalate ", " (showPredicate <$> orphanPs)+                            )+                    extraExplanation =+                      if null orphanXs+                        then Nothing+                        else+                          Just+                            ( "Extra elements: "+                                ++ intercalate+                                  ", "+                                  (("#" ++) . show . fst <$> orphanXs)+                            )+                 in intercalate+                      "; "+                      (catMaybes [missingExplanation, extraExplanation])+    }+  where+    matchOne p (_, x) = accept p x+    matchAll xs = bipartiteMatching matchOne ps (zip [1 :: Int ..] (otoList xs))+    explainMatch (p, (j, x)) = "element #" ++ show j ++ ": " ++ explain p x++-- | A 'Predicate' that accepts data structures whose elements each match the+-- child 'Predicate'.+--+-- >>> accept (each (gt 5)) [4, 5, 6]+-- False+-- >>> accept (each (gt 5)) [6, 7, 8]+-- True+-- >>> accept (each (gt 5)) []+-- True+each :: MonoFoldable t => Predicate (Element t) -> Predicate t+each p =+  Predicate+    { showPredicate = "each (" ++ showPredicate p ++ ")",+      showNegation = "contains (" ++ showNegation p ++ ")",+      accept = all fst . acceptAndExplain,+      explain = \xs ->+        let results = acceptAndExplain xs+            format (i, explanation) =+              "element #" ++ show i ++ ": " ++ explanation+         in if all fst results+              then "all elements " ++ showPredicate p+              else+                intercalate "; and " $+                  format . snd <$> filter (not . fst) results+    }+  where+    acceptAndExplain xs =+      [(accept p x, (i, explain p x)) | i <- [1 :: Int ..] | x <- otoList xs]++-- | A 'Predicate' that accepts data structures which contain at least one+-- element matching the child 'Predicate'.+--+-- >>> accept (contains (gt 5)) [3, 4, 5]+-- False+-- >>> accept (contains (gt 5)) [4, 5, 6]+-- True+-- >>> accept (contains (gt 5)) []+-- False+contains :: MonoFoldable t => Predicate (Element t) -> Predicate t+contains = notP . each . notP++-- | A 'Predicate' that accepts data structures whose elements all satisfy the+-- given child 'Predicate's.+--+-- >>> accept (containsAll [eq "foo", eq "bar"]) ["bar", "foo"]+-- True+-- >>> accept (containsAll [eq "foo", eq "bar"]) ["foo"]+-- False+-- >>> accept (containsAll [eq "foo", eq "bar"]) ["foo", "bar", "qux"]+-- True+--+-- Each child 'Predicate' must be satisfied by a different element, so repeating+-- a 'Predicate' requires that two different matching elements exist.  If you+-- want a 'Predicate' to match multiple elements, instead, you can accomplish+-- this with @'contains' p1 `'andP'` 'contains' p2 `'andP'` ...@.+--+-- >>> accept (containsAll [startsWith "f", endsWith "o"]) ["foo"]+-- False+-- >>> accept (contains (startsWith "f") `andP` contains (endsWith "o")) ["foo"]+-- True+containsAll :: MonoFoldable t => [Predicate (Element t)] -> Predicate t+containsAll ps =+  Predicate+    { showPredicate = "contains all of " ++ show ps,+      showNegation = "not all of " ++ show ps,+      accept = \xs -> let (_, orphanPs, _) = matchAll xs in null orphanPs,+      explain = \xs ->+        let (matches, orphanPs, _) = matchAll xs+         in if null orphanPs+              then intercalate "; and " (explainMatch <$> matches)+              else "Missing: " ++ intercalate ", " (showPredicate <$> orphanPs)+    }+  where+    matchOne p (_, x) = accept p x+    matchAll xs = bipartiteMatching matchOne ps (zip [1 :: Int ..] (otoList xs))+    explainMatch (p, (j, x)) = "element #" ++ show j ++ ": " ++ explain p x++-- | A 'Predicate' that accepts data structures whose elements all satisfy one+-- of the child 'Predicate's.+--+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo"]+-- True+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "bar"]+-- True+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "qux"]+-- False+--+-- Each element must satisfy a different child 'Predicate'.  If you want+-- multiple elements to match the same 'Predicate', instead, you can accomplish+-- this with @'each' (p1 `'orP'` p2 `'orP'` ...)@.+--+-- >>> accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"]+-- False+-- >>> accept (each (eq "foo" `orP` eq "bar")) ["foo", "foo"]+-- True+containsOnly :: MonoFoldable t => [Predicate (Element t)] -> Predicate t+containsOnly ps =+  Predicate+    { showPredicate = "contains only " ++ show ps,+      showNegation = "not only " ++ show ps,+      accept = \xs -> let (_, _, orphanXs) = matchAll xs in null orphanXs,+      explain = \xs ->+        let (matches, _, orphanXs) = matchAll xs+         in if null orphanXs+              then intercalate "; and " (explainMatch <$> matches)+              else+                "Extra elements: "+                  ++ intercalate ", " (("#" ++) . show . fst <$> orphanXs)+    }+  where+    matchOne p (_, x) = accept p x+    matchAll xs = bipartiteMatching matchOne ps (zip [1 :: Int ..] (otoList xs))+    explainMatch (p, (j, x)) = "element #" ++ show j ++ ": " ++ explain p x++-- | Transforms a 'Predicate' on a list of keys into a 'Predicate' on map-like+-- data structures.+--+-- This is equivalent to @'with' ('map' 'fst' '.' 'toList')@, but more readable.+--+-- >>> accept (keys (each (eq "foo"))) [("foo", 5)]+-- True+--+-- >>> accept (keys (each (eq "foo"))) [("foo", 5), ("bar", 6)]+-- False+keys :: (IsList t, Item t ~ (k, v)) => Predicate [k] -> Predicate t+keys p =+  Predicate+    { showPredicate = "keys (" ++ showPredicate p ++ ")",+      showNegation = "keys (" ++ showNegation p ++ ")",+      accept = accept p . map fst . toList,+      explain = ("in keys, " ++) . explain p . map fst . toList+    }++-- | Transforms a 'Predicate' on a list of values into a 'Predicate' on map-like+-- data structures.+--+-- This is equivalent to @'with' ('map' 'snd' '.' 'toList')@, but more readable.+--+-- >>> accept (values (each (eq 5))) [("foo", 5), ("bar", 5)]+-- True+--+-- >>> accept (values (each (eq 5))) [("foo", 5), ("bar", 6)]+-- False+values :: (IsList t, Item t ~ (k, v)) => Predicate [v] -> Predicate t+values p =+  Predicate+    { showPredicate = "values (" ++ showPredicate p ++ ")",+      showNegation = "values (" ++ showNegation p ++ ")",+      accept = accept p . map snd . toList,+      explain = ("in values, " ++) . explain p . map snd . toList+    }++-- | A 'Predicate' that accepts values of 'RealFloat' types that are close to+-- the given number.  The expected precision is scaled based on the target+-- value, so that reasonable rounding error is accepted but grossly inaccurate+-- results are not.+--+-- The following naive use of 'eq' fails due to rounding:+--+-- >>> accept (eq 1.0) (sum (replicate 100 0.01))+-- False+--+-- The solution is to use 'approxEq', which accounts for rounding error.+-- However, 'approxEq' doesn't accept results that are far enough off that they+-- likely arise from incorrect calculations instead of rounding error.+--+-- >>> accept (approxEq 1.0) (sum (replicate 100 0.01))+-- True+-- >>> accept (approxEq 1.0) (sum (replicate 100 0.009999))+-- False+approxEq :: (RealFloat a, Show a) => a -> Predicate a+approxEq x = withDefaultExplain show " " $ \explainImpl ->+  Predicate+    { showPredicate = "≈ " ++ show x,+      showNegation = "≇" ++ show x,+      accept = \y -> abs (x - y) < diff,+      explain = explainImpl+    }+  where+    diff = encodeFloat 1 (snd (decodeFloat x) + floatDigits x `div` 2)++-- | A 'Predicate' that accepts positive numbers of any 'Ord'ered 'Num' type.+--+-- >>> accept positive 1+-- True+--+-- >>> accept positive 0+-- False+--+-- >>> accept positive (-1)+-- False+positive :: (Ord a, Num a) => Predicate a+positive =+  Predicate+    { showPredicate = "positive",+      showNegation = "non-positive",+      accept = \x -> signum x > 0,+      explain = \x ->+        if+            | signum x > 0 -> "value is positive"+            | x == 0 -> "value is zero"+            | signum x < 0 -> "value is negative"+            | otherwise -> "value has unknown sign"+    }++-- | A 'Predicate' that accepts negative numbers of any 'Ord'ered 'Num' type.+--+-- >>> accept negative 1+-- False+--+-- >>> accept negative 0+-- False+--+-- >>> accept negative (-1)+-- True+negative :: (Ord a, Num a) => Predicate a+negative =+  Predicate+    { showPredicate = "negative",+      showNegation = "non-negative",+      accept = \x -> signum x < 0,+      explain = \x ->+        if+            | signum x < 0 -> "value is negative"+            | x == 0 -> "value is zero"+            | signum x < 0 -> "value is positive"+            | otherwise -> "value has unknown sign"+    }++-- | A 'Predicate' that accepts non-positive numbers of any 'Ord'ered 'Num'+-- type.+--+-- >>> accept nonPositive 1+-- False+--+-- >>> accept nonPositive 0+-- True+--+-- >>> accept nonPositive (-1)+-- True+nonPositive :: (Ord a, Num a) => Predicate a+nonPositive = notP positive++-- | A 'Predicate' that accepts non-negative numbers of any 'Ord'ered 'Num'+-- type.+--+-- >>> accept nonNegative 1+-- True+--+-- >>> accept nonNegative 0+-- True+--+-- >>> accept nonNegative (-1)+-- False+nonNegative :: (Ord a, Num a) => Predicate a+nonNegative = notP negative++-- | A 'Predicate' that accepts finite numbers of any 'RealFloat' type.+--+-- >>> accept finite 1.0+-- True+-- >>> accept finite (0 / 0)+-- False+-- >>> accept finite (1 / 0)+-- False+finite :: RealFloat a => Predicate a+finite =+  Predicate+    { showPredicate = "finite",+      showNegation = "non-finite",+      accept = isFinite,+      explain = \x ->+        if isFinite x+          then "value is finite"+          else "value is not finite"+    }+  where+    isFinite x = not (isInfinite x) && not (isNaN x)++-- | A 'Predicate' that accepts infinite numbers of any 'RealFloat' type.+--+-- >>> accept infinite 1.0+-- False+-- >>> accept infinite (0 / 0)+-- False+-- >>> accept infinite (1 / 0)+-- True+infinite :: RealFloat a => Predicate a+infinite =+  Predicate+    { showPredicate = "infinite",+      showNegation = "non-infinite",+      accept = isInfinite,+      explain = \x ->+        if isInfinite x+          then "value is infinite"+          else "value is not infinite"+    }++-- | A 'Predicate' that accepts NaN values of any 'RealFloat' type.+--+-- >>> accept nAn 1.0+-- False+-- >>> accept nAn (0 / 0)+-- True+-- >>> accept nAn (1 / 0)+-- False+nAn :: RealFloat a => Predicate a+nAn =+  Predicate+    { showPredicate = "NaN",+      showNegation = "non-NaN",+      accept = isNaN,+      explain = \x ->+        if isNaN x+          then "value is NaN"+          else "value is not NaN"+    }++-- | A conversion from @a -> 'Bool'@ to 'Predicate'.  This is a fallback that+-- can be used to build a 'Predicate' that checks anything at all.  However, its+-- description will be less helpful than standard 'Predicate's.+--+-- >>> accept (is even) 3+-- False+-- >>> accept (is even) 4+-- True+is :: HasCallStack => (a -> Bool) -> Predicate a+is p =+  Predicate+    { showPredicate = withLoc (locate callStack "custom predicate"),+      showNegation = withLoc (locate callStack "negated custom predicate"),+      accept = p,+      explain = \x ->+        if p x+          then "value matched custom predicate"+          else "value did not match custom predicate"+    }++-- | A Template Haskell splice that acts like 'is', but receives a quoted+-- expression at compile time and has a more helpful description for error+-- messages.+--+-- >>> accept $(qIs [| even |]) 3+-- False+-- >>> accept $(qIs [| even |]) 4+-- True+--+-- >>> show $(qIs [| even |])+-- "even"+qIs :: HasCallStack => ExpQ -> ExpQ+qIs p =+  [|+    Predicate+      { showPredicate = $description,+        showNegation = "not " ++ $description,+        accept = $p,+        explain = \x -> if $p x then $description else "not " ++ $description+      }+    |]+  where+    description = lift . pprint . removeModNames =<< p++-- | A combinator to lift a 'Predicate' to work on a property or computed value+-- of the original value.+--+-- >>> accept (with abs (gt 5)) (-6)+-- True+-- >>> accept (with abs (gt 5)) (-5)+-- False+-- >>> accept (with reverse (eq "olleh")) "hello"+-- True+-- >>> accept (with reverse (eq "olleh")) "goodbye"+-- False+with :: HasCallStack => (a -> b) -> Predicate b -> Predicate a+with f p =+  Predicate+    { showPredicate = prop ++ ": " ++ show p,+      showNegation = prop ++ ": " ++ showNegation p,+      accept = accept p . f,+      explain = ((prop ++ ": ") ++) . explain p . f+    }+  where+    prop = withLoc (locate callStack "property")++-- | A Template Haskell splice that acts like 'is', but receives a quoted typed+-- expression at compile time and has a more helpful description for error+-- messages.+--+-- >>> accept ($(qWith [| abs |]) (gt 5)) (-6)+-- True+-- >>> accept ($(qWith [| abs |]) (gt 5)) (-5)+-- False+-- >>> accept ($(qWith [| reverse |]) (eq "olleh")) "hello"+-- True+-- >>> accept ($(qWith [| reverse |]) (eq "olleh")) "goodbye"+-- False+--+-- >>> show ($(qWith [| abs |]) (gt 5))+-- "abs: > 5"+qWith :: ExpQ -> ExpQ+qWith f =+  [|+    \p ->+      Predicate+        { showPredicate = $prop ++ ": " ++ show p,+          showNegation = $prop ++ ": " ++ showNegation p,+          accept = accept p . $f,+          explain = (($prop ++ ": ") ++) . explain p . $f+        }+    |]+  where+    prop = lift . pprint . removeModNames =<< f++-- | A Template Haskell splice that turns a quoted pattern into a predicate that+-- accepts values that match the pattern.+--+-- >>> accept $(qMatch [p| Just (Left _) |]) Nothing+-- False+-- >>> accept $(qMatch [p| Just (Left _) |]) (Just (Left 5))+-- True+-- >>> accept $(qMatch [p| Just (Left _) |]) (Just (Right 5))+-- False+--+-- >>> show $(qMatch [p| Just (Left _) |])+-- "Just (Left _)"+qMatch :: PatQ -> ExpQ+qMatch qpat =+  [|+    Predicate+      { showPredicate = $patString,+        showNegation = "not " ++ $patString,+        accept = \case+          $qpat -> True+          _ -> False,+        explain = \case+          $qpat -> "value matched " ++ $patString+          _ -> "value didn't match " ++ $patString+      }+    |]+  where+    patString = lift . pprint . removeModNames =<< qpat++-- | Converts a 'Predicate' to a new type.  Typically used with visible type+-- application, as in the examples below.+--+-- >>> accept (typed @String anything) "foo"+-- True+-- >>> accept (typed @String (sizeIs (gt 5))) "foo"+-- False+-- >>> accept (typed @String anything) (42 :: Int)+-- False+typed :: forall a b. (Typeable a, Typeable b) => Predicate a -> Predicate b+typed p =+  Predicate+    { showPredicate =+        showPredicate p ++ " :: " ++ show (typeRep (Proxy :: Proxy a)),+      showNegation =+        "not " ++ showPredicate p ++ " :: "+          ++ show (typeRep (Proxy :: Proxy a)),+      accept = \x -> case cast x of+        Nothing -> False+        Just y -> accept p y,+      explain = \x -> case cast x of+        Nothing ->+          "wrong type ("+            ++ show (typeRep (undefined :: Proxy b))+            ++ " vs. "+            ++ show (typeRep (undefined :: Proxy a))+            ++ ")"+        Just y -> explain p y+    }

@@ -0,0 +1,95 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | An implementation of bipartite matching using the Ford-Fulkerson algorithm.+module Test.Predicates.Internal.FlowMatcher where++import Control.Monad (forM_, when)+import Control.Monad.ST (ST)+import Data.Array.IArray (Array, assocs, elems)+import Data.Array.ST+  ( MArray (newArray),+    STArray,+    newListArray,+    readArray,+    runSTArray,+    writeArray,+  )+import Data.List ((\\))+import Data.Maybe (catMaybes)++-- $setup+-- >>> :set -Wno-type-defaults++-- | Computes the best bipartite matching of the elements in the two lists,+-- given the compatibility function.+--+-- Returns matched pairs, then unmatched lhs elements, then unmatched rhs+-- elements.+--+-- >>> bipartiteMatching (==) [1 .. 5] [6, 5 .. 2]+-- ([(2,2),(3,3),(4,4),(5,5)],[1],[6])+bipartiteMatching ::+  forall a b. (a -> b -> Bool) -> [a] -> [b] -> ([(a, b)], [a], [b])+bipartiteMatching compatible xs ys = (matchedPairs, unmatchedX, unmatchedY)+  where+    matchedPairs :: [(a, b)]+    matchedPairs = [(xs !! i, ys !! j) | (i, Just j) <- assocs matches]++    unmatchedX :: [a]+    unmatchedX = [xs !! i | (i, Nothing) <- assocs matches]++    unmatchedY :: [b]+    unmatchedY = [ys !! j | j <- [0 .. numYs - 1] \\ catMaybes (elems matches)]++    matches :: Array Int (Maybe Int)+    matches = runSTArray st++    st :: forall s. ST s (STArray s Int (Maybe Int))+    st = do+      compatArray <-+        newListArray+          ((0, 0), (numXs - 1, numYs - 1))+          [compatible x y | x <- xs, y <- ys] ::+          ST s (STArray s (Int, Int) Bool)+      matchArray <-+        newArray (0, numXs - 1) Nothing ::+          ST s (STArray s Int (Maybe Int))+      forM_ [0 .. numYs - 1] $ \j -> do+        seen <-+          newArray (0, numXs - 1) False :: ST s (STArray s Int Bool)+        _ <- go compatArray j matchArray seen+        return ()++      return matchArray++    numXs, numYs :: Int+    numXs = length xs+    numYs = length ys++    go ::+      forall s.+      STArray s (Int, Int) Bool ->+      Int ->+      STArray s Int (Maybe Int) ->+      STArray s Int Bool ->+      ST s Bool+    go compatArray j matchArray seen = loop False 0+      where+        loop True _ = return True+        loop _ i+          | i == numXs = return False+          | otherwise = do+            compat <- readArray compatArray (i, j)+            isSeen <- readArray seen i+            replace <-+              if isSeen || not compat+                then return False+                else do+                  writeArray seen i True+                  matchNum <- readArray matchArray i+                  case matchNum of+                    Nothing -> return True+                    Just n -> go compatArray n matchArray seen+            when replace $ writeArray matchArray i (Just j)+            loop replace (i + 1)

@@ -0,0 +1,47 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleContexts #-}++-- | Internal utilities used for HMock implementation.+module Test.Predicates.Internal.Util where++import Data.Generics (Data, everywhere, mkT)+import Data.MonoTraversable (Element)+import qualified Data.Sequences as Seq+import GHC.Stack (CallStack, getCallStack, prettySrcLoc)+import Language.Haskell.TH.Syntax (NameFlavour (..))++-- | A value together with its source location.+data Located a = Loc (Maybe String) a deriving (Functor)++-- | Annotates a value with its source location from the call stack.+locate :: CallStack -> a -> Located a+locate stack = case map snd (getCallStack stack) of+  (loc : _) -> Loc (Just (prettySrcLoc loc))+  _ -> Loc Nothing++-- | Formats a 'Located' 'String' to include its source location.+withLoc :: Located String -> String+withLoc (Loc Nothing s) = s+withLoc (Loc (Just loc) s) = s ++ " at " ++ loc++-- | Returns all ways to choose one element from a list, and the corresponding+-- remaining list.+choices :: [a] -> [(a, [a])]+choices [] = []+choices (x : xs) = (x, xs) : (fmap (x :) <$> choices xs)++-- | Checks if one sequence is a subsequence of another.+isSubsequenceOf :: (Seq.IsSequence t, Eq (Element t)) => t -> t -> Bool+xs `isSubsequenceOf` ys = case Seq.uncons xs of+  Nothing -> True+  Just (x, xs') -> case Seq.uncons (snd (Seq.break (== x) ys)) of+    Nothing -> False+    Just (_, ys') -> xs' `isSubsequenceOf` ys'++-- | Removes all module names from Template Haskell names in the given value, so+-- that it will pretty-print more cleanly.+removeModNames :: Data a => a -> a+removeModNames = everywhere (mkT unMod)+  where+    unMod NameG {} = NameS+    unMod other = other

@@ -0,0 +1,12 @@+-- Do not edit! Automatically created with doctest-extract.+module DocTests.All where++import qualified DocTests.Test.Predicates+import qualified DocTests.Test.Predicates.Internal.FlowMatcher++import qualified Test.DocTest.Driver as DocTest++main :: DocTest.T ()+main = do+    DocTests.Test.Predicates.test+    DocTests.Test.Predicates.Internal.FlowMatcher.test

@@ -0,0 +1,928 @@+-- Do not edit! Automatically created with doctest-extract from src/Test/Predicates.hs+{-# LINE 90 "src/Test/Predicates.hs" #-}++{-# OPTIONS_GHC -XTemplateHaskell #-}+{-# OPTIONS_GHC -XTypeApplications #-}+{-# OPTIONS_GHC -Wno-type-defaults #-}+module DocTests.Test.Predicates where++import Test.Predicates+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 94 "src/Test/Predicates.hs" #-}++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Test.Predicates:121: "+{-# LINE 121 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 121 "src/Test/Predicates.hs" #-}+      (accept anything "foo")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:123: "+{-# LINE 123 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 123 "src/Test/Predicates.hs" #-}+      (accept anything undefined)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:136: "+{-# LINE 136 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 136 "src/Test/Predicates.hs" #-}+      (accept (eq "foo") "foo")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:138: "+{-# LINE 138 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 138 "src/Test/Predicates.hs" #-}+      (accept (eq "foo") "bar")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:154: "+{-# LINE 154 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 154 "src/Test/Predicates.hs" #-}+      (accept (neq "foo") "foo")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:156: "+{-# LINE 156 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 156 "src/Test/Predicates.hs" #-}+      (accept (neq "foo") "bar")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:163: "+{-# LINE 163 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 163 "src/Test/Predicates.hs" #-}+      (accept (gt 5) 4)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:165: "+{-# LINE 165 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 165 "src/Test/Predicates.hs" #-}+      (accept (gt 5) 5)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:167: "+{-# LINE 167 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 167 "src/Test/Predicates.hs" #-}+      (accept (gt 5) 6)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:181: "+{-# LINE 181 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 181 "src/Test/Predicates.hs" #-}+      (accept (geq 5) 4)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:183: "+{-# LINE 183 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 183 "src/Test/Predicates.hs" #-}+      (accept (geq 5) 5)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:185: "+{-# LINE 185 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 185 "src/Test/Predicates.hs" #-}+      (accept (geq 5) 6)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:198: "+{-# LINE 198 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 198 "src/Test/Predicates.hs" #-}+      (accept (lt 5) 4)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:200: "+{-# LINE 200 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 200 "src/Test/Predicates.hs" #-}+      (accept (lt 5) 5)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:202: "+{-# LINE 202 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 202 "src/Test/Predicates.hs" #-}+      (accept (lt 5) 6)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:209: "+{-# LINE 209 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 209 "src/Test/Predicates.hs" #-}+      (accept (leq 5) 4)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:211: "+{-# LINE 211 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 211 "src/Test/Predicates.hs" #-}+      (accept (leq 5) 5)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:213: "+{-# LINE 213 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 213 "src/Test/Predicates.hs" #-}+      (accept (leq 5) 6)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:221: "+{-# LINE 221 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 221 "src/Test/Predicates.hs" #-}+      (accept (just (eq "value")) Nothing)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:223: "+{-# LINE 223 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 223 "src/Test/Predicates.hs" #-}+      (accept (just (eq "value")) (Just "value"))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:225: "+{-# LINE 225 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 225 "src/Test/Predicates.hs" #-}+      (accept (just (eq "value")) (Just "wrong value"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:239: "+{-# LINE 239 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 239 "src/Test/Predicates.hs" #-}+      (accept nothing Nothing)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:242: "+{-# LINE 242 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 242 "src/Test/Predicates.hs" #-}+      (accept nothing (Just "something"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:256: "+{-# LINE 256 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 256 "src/Test/Predicates.hs" #-}+      (accept (left (eq "value")) (Left "value"))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:258: "+{-# LINE 258 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 258 "src/Test/Predicates.hs" #-}+      (accept (left (eq "value")) (Right "value"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:260: "+{-# LINE 260 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 260 "src/Test/Predicates.hs" #-}+      (accept (left (eq "value")) (Left "wrong value"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:274: "+{-# LINE 274 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 274 "src/Test/Predicates.hs" #-}+      (accept (right (eq "value")) (Right "value"))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:276: "+{-# LINE 276 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 276 "src/Test/Predicates.hs" #-}+      (accept (right (eq "value")) (Right "wrong value"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:278: "+{-# LINE 278 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 278 "src/Test/Predicates.hs" #-}+      (accept (right (eq "value")) (Left "value"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:292: "+{-# LINE 292 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 292 "src/Test/Predicates.hs" #-}+      (accept (zipP (eq "foo") (eq "bar")) ("foo", "bar"))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:294: "+{-# LINE 294 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 294 "src/Test/Predicates.hs" #-}+      (accept (zipP (eq "foo") (eq "bar")) ("bar", "foo"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:318: "+{-# LINE 318 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 318 "src/Test/Predicates.hs" #-}+      (accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("foo", "bar", "qux"))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:320: "+{-# LINE 320 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 320 "src/Test/Predicates.hs" #-}+      (accept (zip3P (eq "foo") (eq "bar") (eq "qux")) ("qux", "bar", "foo"))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:345: "+{-# LINE 345 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 345 "src/Test/Predicates.hs" #-}+      (accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (1, 2, 3, 4))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:347: "+{-# LINE 347 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 347 "src/Test/Predicates.hs" #-}+      (accept (zip4P (eq 1) (eq 2) (eq 3) (eq 4)) (4, 3, 2, 1))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:378: "+{-# LINE 378 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 378 "src/Test/Predicates.hs" #-}+      (accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (1, 2, 3, 4, 5))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:380: "+{-# LINE 380 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 380 "src/Test/Predicates.hs" #-}+      (accept (zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5)) (5, 4, 3, 2, 1))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:412: "+{-# LINE 412 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 412 "src/Test/Predicates.hs" #-}+      (accept (lt "foo" `andP` gt "bar") "eta")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:414: "+{-# LINE 414 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 414 "src/Test/Predicates.hs" #-}+      (accept (lt "foo" `andP` gt "bar") "quz")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:416: "+{-# LINE 416 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 416 "src/Test/Predicates.hs" #-}+      (accept (lt "foo" `andP` gt "bar") "alpha")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:433: "+{-# LINE 433 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 433 "src/Test/Predicates.hs" #-}+      (accept (lt "bar" `orP` gt "foo") "eta")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:435: "+{-# LINE 435 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 435 "src/Test/Predicates.hs" #-}+      (accept (lt "bar" `orP` gt "foo") "quz")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:437: "+{-# LINE 437 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 437 "src/Test/Predicates.hs" #-}+      (accept (lt "bar" `orP` gt "foo") "alpha")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:445: "+{-# LINE 445 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 445 "src/Test/Predicates.hs" #-}+      (accept (notP (eq "negative")) "positive")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:447: "+{-# LINE 447 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 447 "src/Test/Predicates.hs" #-}+      (accept (notP (eq "negative")) "negative")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:460: "+{-# LINE 460 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 460 "src/Test/Predicates.hs" #-}+      (accept (startsWith "fun") "fungible")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:462: "+{-# LINE 462 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 462 "src/Test/Predicates.hs" #-}+      (accept (startsWith "gib") "fungible")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:475: "+{-# LINE 475 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 475 "src/Test/Predicates.hs" #-}+      (accept (endsWith "ow") "crossbow")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:477: "+{-# LINE 477 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 477 "src/Test/Predicates.hs" #-}+      (accept (endsWith "ow") "trebuchet")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:491: "+{-# LINE 491 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 491 "src/Test/Predicates.hs" #-}+      (accept (hasSubstr "i") "team")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:493: "+{-# LINE 493 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 493 "src/Test/Predicates.hs" #-}+      (accept (hasSubstr "i") "partnership")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:507: "+{-# LINE 507 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 507 "src/Test/Predicates.hs" #-}+      (accept (hasSubsequence [1..5]) [1, 2, 3, 4, 5])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:509: "+{-# LINE 509 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 509 "src/Test/Predicates.hs" #-}+      (accept (hasSubsequence [1..5]) [0, 1, 0, 2, 0, 3, 0, 4, 0, 5, 0])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:511: "+{-# LINE 511 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 511 "src/Test/Predicates.hs" #-}+      (accept (hasSubsequence [1..5]) [2, 3, 5, 7, 11])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:525: "+{-# LINE 525 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 525 "src/Test/Predicates.hs" #-}+      (accept (caseInsensitive startsWith "foo") "FOOTBALL!")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:527: "+{-# LINE 527 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 527 "src/Test/Predicates.hs" #-}+      (accept (caseInsensitive endsWith "ball") "soccer")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:529: "+{-# LINE 529 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 529 "src/Test/Predicates.hs" #-}+      (accept (caseInsensitive eq "time") "TIME")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:531: "+{-# LINE 531 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 531 "src/Test/Predicates.hs" #-}+      (accept (caseInsensitive gt "NOTHING") "everything")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:558: "+{-# LINE 558 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 558 "src/Test/Predicates.hs" #-}+      (accept (matchesRegex "x{2,5}y?") "xxxy")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:560: "+{-# LINE 560 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 560 "src/Test/Predicates.hs" #-}+      (accept (matchesRegex "x{2,5}y?") "xyy")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:562: "+{-# LINE 562 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 562 "src/Test/Predicates.hs" #-}+      (accept (matchesRegex "x{2,5}y?") "wxxxyz")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:592: "+{-# LINE 592 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 592 "src/Test/Predicates.hs" #-}+      (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XXXY")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:594: "+{-# LINE 594 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 594 "src/Test/Predicates.hs" #-}+      (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "XYY")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:596: "+{-# LINE 596 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 596 "src/Test/Predicates.hs" #-}+      (accept (matchesCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:632: "+{-# LINE 632 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 632 "src/Test/Predicates.hs" #-}+      (accept (containsRegex "x{2,5}y?") "xxxy")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:634: "+{-# LINE 634 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 634 "src/Test/Predicates.hs" #-}+      (accept (containsRegex "x{2,5}y?") "xyy")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:636: "+{-# LINE 636 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 636 "src/Test/Predicates.hs" #-}+      (accept (containsRegex "x{2,5}y?") "wxxxyz")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:660: "+{-# LINE 660 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 660 "src/Test/Predicates.hs" #-}+      (accept (containsCaseInsensitiveRegex "x{2,5}y?") "XXXY")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:662: "+{-# LINE 662 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 662 "src/Test/Predicates.hs" #-}+      (accept (containsCaseInsensitiveRegex "x{2,5}y?") "XYY")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:664: "+{-# LINE 664 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 664 "src/Test/Predicates.hs" #-}+      (accept (containsCaseInsensitiveRegex "x{2,5}y?") "WXXXYZ")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:688: "+{-# LINE 688 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 688 "src/Test/Predicates.hs" #-}+      (accept isEmpty ([] :: [Int]))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:690: "+{-# LINE 690 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 690 "src/Test/Predicates.hs" #-}+      (accept isEmpty [1, 2, 3])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:692: "+{-# LINE 692 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 692 "src/Test/Predicates.hs" #-}+      (accept isEmpty "")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:694: "+{-# LINE 694 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 694 "src/Test/Predicates.hs" #-}+      (accept isEmpty "gas tank")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:707: "+{-# LINE 707 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 707 "src/Test/Predicates.hs" #-}+      (accept nonEmpty ([] :: [Int]))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:709: "+{-# LINE 709 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 709 "src/Test/Predicates.hs" #-}+      (accept nonEmpty [1, 2, 3])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:711: "+{-# LINE 711 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 711 "src/Test/Predicates.hs" #-}+      (accept nonEmpty "")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:713: "+{-# LINE 713 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 713 "src/Test/Predicates.hs" #-}+      (accept nonEmpty "gas tank")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:721: "+{-# LINE 721 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 721 "src/Test/Predicates.hs" #-}+      (accept (sizeIs (lt 3)) ['a' .. 'f'])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:723: "+{-# LINE 723 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 723 "src/Test/Predicates.hs" #-}+      (accept (sizeIs (lt 3)) ['a' .. 'b'])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:744: "+{-# LINE 744 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 744 "src/Test/Predicates.hs" #-}+      (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:746: "+{-# LINE 746 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 746 "src/Test/Predicates.hs" #-}+      (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 3, 4, 5])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:748: "+{-# LINE 748 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 748 "src/Test/Predicates.hs" #-}+      (accept (elemsAre [lt 3, lt 4, lt 5]) [2, 10, 4])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:780: "+{-# LINE 780 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 780 "src/Test/Predicates.hs" #-}+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:782: "+{-# LINE 782 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 782 "src/Test/Predicates.hs" #-}+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [2, 3, 1])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:784: "+{-# LINE 784 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 784 "src/Test/Predicates.hs" #-}+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 2, 3, 4])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:786: "+{-# LINE 786 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 786 "src/Test/Predicates.hs" #-}+      (accept (unorderedElemsAre [eq 1, eq 2, eq 3]) [1, 3])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:833: "+{-# LINE 833 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 833 "src/Test/Predicates.hs" #-}+      (accept (each (gt 5)) [4, 5, 6])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:835: "+{-# LINE 835 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 835 "src/Test/Predicates.hs" #-}+      (accept (each (gt 5)) [6, 7, 8])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:837: "+{-# LINE 837 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 837 "src/Test/Predicates.hs" #-}+      (accept (each (gt 5)) [])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:862: "+{-# LINE 862 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 862 "src/Test/Predicates.hs" #-}+      (accept (contains (gt 5)) [3, 4, 5])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:864: "+{-# LINE 864 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 864 "src/Test/Predicates.hs" #-}+      (accept (contains (gt 5)) [4, 5, 6])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:866: "+{-# LINE 866 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 866 "src/Test/Predicates.hs" #-}+      (accept (contains (gt 5)) [])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:874: "+{-# LINE 874 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 874 "src/Test/Predicates.hs" #-}+      (accept (containsAll [eq "foo", eq "bar"]) ["bar", "foo"])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:876: "+{-# LINE 876 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 876 "src/Test/Predicates.hs" #-}+      (accept (containsAll [eq "foo", eq "bar"]) ["foo"])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:878: "+{-# LINE 878 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 878 "src/Test/Predicates.hs" #-}+      (accept (containsAll [eq "foo", eq "bar"]) ["foo", "bar", "qux"])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:886: "+{-# LINE 886 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 886 "src/Test/Predicates.hs" #-}+      (accept (containsAll [startsWith "f", endsWith "o"]) ["foo"])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:888: "+{-# LINE 888 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 888 "src/Test/Predicates.hs" #-}+      (accept (contains (startsWith "f") `andP` contains (endsWith "o")) ["foo"])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:910: "+{-# LINE 910 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 910 "src/Test/Predicates.hs" #-}+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo"])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:912: "+{-# LINE 912 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 912 "src/Test/Predicates.hs" #-}+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "bar"])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:914: "+{-# LINE 914 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 914 "src/Test/Predicates.hs" #-}+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "qux"])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:921: "+{-# LINE 921 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 921 "src/Test/Predicates.hs" #-}+      (accept (containsOnly [eq "foo", eq "bar"]) ["foo", "foo"])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:923: "+{-# LINE 923 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 923 "src/Test/Predicates.hs" #-}+      (accept (each (eq "foo" `orP` eq "bar")) ["foo", "foo"])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:949: "+{-# LINE 949 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 949 "src/Test/Predicates.hs" #-}+      (accept (keys (each (eq "foo"))) [("foo", 5)])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:952: "+{-# LINE 952 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 952 "src/Test/Predicates.hs" #-}+      (accept (keys (each (eq "foo"))) [("foo", 5), ("bar", 6)])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:968: "+{-# LINE 968 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 968 "src/Test/Predicates.hs" #-}+      (accept (values (each (eq 5))) [("foo", 5), ("bar", 5)])+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:971: "+{-# LINE 971 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 971 "src/Test/Predicates.hs" #-}+      (accept (values (each (eq 5))) [("foo", 5), ("bar", 6)])+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:989: "+{-# LINE 989 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 989 "src/Test/Predicates.hs" #-}+      (accept (eq 1.0) (sum (replicate 100 0.01)))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:996: "+{-# LINE 996 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 996 "src/Test/Predicates.hs" #-}+      (accept (approxEq 1.0) (sum (replicate 100 0.01)))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:998: "+{-# LINE 998 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 998 "src/Test/Predicates.hs" #-}+      (accept (approxEq 1.0) (sum (replicate 100 0.009999)))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1013: "+{-# LINE 1013 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1013 "src/Test/Predicates.hs" #-}+      (accept positive 1)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1016: "+{-# LINE 1016 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1016 "src/Test/Predicates.hs" #-}+      (accept positive 0)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1019: "+{-# LINE 1019 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1019 "src/Test/Predicates.hs" #-}+      (accept positive (-1))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1037: "+{-# LINE 1037 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1037 "src/Test/Predicates.hs" #-}+      (accept negative 1)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1040: "+{-# LINE 1040 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1040 "src/Test/Predicates.hs" #-}+      (accept negative 0)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1043: "+{-# LINE 1043 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1043 "src/Test/Predicates.hs" #-}+      (accept negative (-1))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1062: "+{-# LINE 1062 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1062 "src/Test/Predicates.hs" #-}+      (accept nonPositive 1)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1065: "+{-# LINE 1065 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1065 "src/Test/Predicates.hs" #-}+      (accept nonPositive 0)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1068: "+{-# LINE 1068 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1068 "src/Test/Predicates.hs" #-}+      (accept nonPositive (-1))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1076: "+{-# LINE 1076 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1076 "src/Test/Predicates.hs" #-}+      (accept nonNegative 1)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1079: "+{-# LINE 1079 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1079 "src/Test/Predicates.hs" #-}+      (accept nonNegative 0)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1082: "+{-# LINE 1082 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1082 "src/Test/Predicates.hs" #-}+      (accept nonNegative (-1))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1089: "+{-# LINE 1089 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1089 "src/Test/Predicates.hs" #-}+      (accept finite 1.0)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1091: "+{-# LINE 1091 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1091 "src/Test/Predicates.hs" #-}+      (accept finite (0 / 0))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1093: "+{-# LINE 1093 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1093 "src/Test/Predicates.hs" #-}+      (accept finite (1 / 0))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1111: "+{-# LINE 1111 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1111 "src/Test/Predicates.hs" #-}+      (accept infinite 1.0)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1113: "+{-# LINE 1113 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1113 "src/Test/Predicates.hs" #-}+      (accept infinite (0 / 0))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1115: "+{-# LINE 1115 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1115 "src/Test/Predicates.hs" #-}+      (accept infinite (1 / 0))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1131: "+{-# LINE 1131 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1131 "src/Test/Predicates.hs" #-}+      (accept nAn 1.0)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1133: "+{-# LINE 1133 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1133 "src/Test/Predicates.hs" #-}+      (accept nAn (0 / 0))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1135: "+{-# LINE 1135 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1135 "src/Test/Predicates.hs" #-}+      (accept nAn (1 / 0))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1153: "+{-# LINE 1153 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1153 "src/Test/Predicates.hs" #-}+      (accept (is even) 3)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1155: "+{-# LINE 1155 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1155 "src/Test/Predicates.hs" #-}+      (accept (is even) 4)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1173: "+{-# LINE 1173 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1173 "src/Test/Predicates.hs" #-}+      (accept $(qIs [| even |]) 3)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1175: "+{-# LINE 1175 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1175 "src/Test/Predicates.hs" #-}+      (accept $(qIs [| even |]) 4)+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1178: "+{-# LINE 1178 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1178 "src/Test/Predicates.hs" #-}+      (show $(qIs [| even |]))+  [ExpectedLine [LineChunk "\"even\""]]+ DocTest.printPrefix "Test.Predicates:1196: "+{-# LINE 1196 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1196 "src/Test/Predicates.hs" #-}+      (accept (with abs (gt 5)) (-6))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1198: "+{-# LINE 1198 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1198 "src/Test/Predicates.hs" #-}+      (accept (with abs (gt 5)) (-5))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1200: "+{-# LINE 1200 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1200 "src/Test/Predicates.hs" #-}+      (accept (with reverse (eq "olleh")) "hello")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1202: "+{-# LINE 1202 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1202 "src/Test/Predicates.hs" #-}+      (accept (with reverse (eq "olleh")) "goodbye")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1219: "+{-# LINE 1219 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1219 "src/Test/Predicates.hs" #-}+      (accept ($(qWith [| abs |]) (gt 5)) (-6))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1221: "+{-# LINE 1221 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1221 "src/Test/Predicates.hs" #-}+      (accept ($(qWith [| abs |]) (gt 5)) (-5))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1223: "+{-# LINE 1223 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1223 "src/Test/Predicates.hs" #-}+      (accept ($(qWith [| reverse |]) (eq "olleh")) "hello")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1225: "+{-# LINE 1225 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1225 "src/Test/Predicates.hs" #-}+      (accept ($(qWith [| reverse |]) (eq "olleh")) "goodbye")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1228: "+{-# LINE 1228 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1228 "src/Test/Predicates.hs" #-}+      (show ($(qWith [| abs |]) (gt 5)))+  [ExpectedLine [LineChunk "\"abs: > 5\""]]+ DocTest.printPrefix "Test.Predicates:1247: "+{-# LINE 1247 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1247 "src/Test/Predicates.hs" #-}+      (accept $(qMatch [p| Just (Left _) |]) Nothing)+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1249: "+{-# LINE 1249 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1249 "src/Test/Predicates.hs" #-}+      (accept $(qMatch [p| Just (Left _) |]) (Just (Left 5)))+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1251: "+{-# LINE 1251 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1251 "src/Test/Predicates.hs" #-}+      (accept $(qMatch [p| Just (Left _) |]) (Just (Right 5)))+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1254: "+{-# LINE 1254 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1254 "src/Test/Predicates.hs" #-}+      (show $(qMatch [p| Just (Left _) |]))+  [ExpectedLine [LineChunk "\"Just (Left _)\""]]+ DocTest.printPrefix "Test.Predicates:1276: "+{-# LINE 1276 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1276 "src/Test/Predicates.hs" #-}+      (accept (typed @String anything) "foo")+  [ExpectedLine [LineChunk "True"]]+ DocTest.printPrefix "Test.Predicates:1278: "+{-# LINE 1278 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1278 "src/Test/Predicates.hs" #-}+      (accept (typed @String (sizeIs (gt 5))) "foo")+  [ExpectedLine [LineChunk "False"]]+ DocTest.printPrefix "Test.Predicates:1280: "+{-# LINE 1280 "src/Test/Predicates.hs" #-}+ DocTest.example+{-# LINE 1280 "src/Test/Predicates.hs" #-}+      (accept (typed @String anything) (42 :: Int))+  [ExpectedLine [LineChunk "False"]]

@@ -0,0 +1,20 @@+-- Do not edit! Automatically created with doctest-extract from src/Test/Predicates/Internal/FlowMatcher.hs+{-# LINE 14 "src/Test/Predicates/Internal/FlowMatcher.hs" #-}++{-# OPTIONS_GHC -Wno-type-defaults #-}+module DocTests.Test.Predicates.Internal.FlowMatcher where++import Test.Predicates.Internal.FlowMatcher+import Test.DocTest.Base+import qualified Test.DocTest.Driver as DocTest++{-# LINE 16 "src/Test/Predicates/Internal/FlowMatcher.hs" #-}++test :: DocTest.T ()+test = do+ DocTest.printPrefix "Test.Predicates.Internal.FlowMatcher:23: "+{-# LINE 23 "src/Test/Predicates/Internal/FlowMatcher.hs" #-}+ DocTest.example+{-# LINE 23 "src/Test/Predicates/Internal/FlowMatcher.hs" #-}+      (bipartiteMatching (==) [1 .. 5] [6, 5 .. 2])+  [ExpectedLine [LineChunk "([(2,2),(3,3),(4,4),(5,5)],[1],[6])"]]

@@ -0,0 +1,143 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}++import Data.List (isPrefixOf)+import Data.Typeable (Typeable)+import qualified DocTests.All+import qualified Test.DocTest.Driver as DocTest+import Test.Hspec+import Test.Predicates++main :: IO ()+main = do+  hspec predicateTests+  DocTest.run DocTests.All.main++predicateTests :: SpecWith ()+predicateTests = do+  describe "Predicate" $ do+    it "describes itself" $+      example $ do+        show anything `shouldBe` "anything"+        show (eq "foo") `shouldBe` "\"foo\""+        show (neq "foo") `shouldBe` "≠ \"foo\""+        show (gt "foo") `shouldBe` "> \"foo\""+        show (geq "foo") `shouldBe` "≥ \"foo\""+        show (lt "foo") `shouldBe` "< \"foo\""+        show (leq "foo") `shouldBe` "≤ \"foo\""+        show (just (gt "foo")) `shouldBe` "Just (> \"foo\")"+        show (left (gt "foo")) `shouldBe` "Left (> \"foo\")"+        show (right (gt "foo")) `shouldBe` "Right (> \"foo\")"+        show (zipP (eq 1) (eq 2) :: Predicate (Int, Int)) `shouldBe` "(1,2)"+        show (zip3P (eq 1) (eq 2) (eq 3) :: Predicate (Int, Int, Int))+          `shouldBe` "(1,2,3)"+        show+          ( zip4P (eq 1) (eq 2) (eq 3) (eq 4) ::+              Predicate (Int, Int, Int, Int)+          )+          `shouldBe` "(1,2,3,4)"+        show+          ( zip5P (eq 1) (eq 2) (eq 3) (eq 4) (eq 5) ::+              Predicate (Int, Int, Int, Int, Int)+          )+          `shouldBe` "(1,2,3,4,5)"+        show (lt "foo" `andP` gt "bar")+          `shouldBe` "< \"foo\" and > \"bar\""+        show (lt "bar" `orP` gt "foo")+          `shouldBe` "< \"bar\" or > \"foo\""+        show (notP (gt "foo")) `shouldBe` "≤ \"foo\""+        show (startsWith "fun") `shouldBe` "starts with \"fun\""+        show (endsWith "ing") `shouldBe` "ends with \"ing\""+        show (hasSubstr "i") `shouldBe` "has substring \"i\""+        show (hasSubsequence "abc") `shouldBe` "has subsequence \"abc\""+        show (caseInsensitive eq "foo") `shouldBe` "(case insensitive) \"foo\""+        show (caseInsensitive startsWith "foo")+          `shouldBe` "(case insensitive) starts with \"foo\""+        show (caseInsensitive endsWith "foo")+          `shouldBe` "(case insensitive) ends with \"foo\""+        show (matchesRegex "foo" :: Predicate String)+          `shouldBe` "/foo/"+        show (matchesCaseInsensitiveRegex "foo" :: Predicate String)+          `shouldBe` "/foo/i"+        show (containsRegex "foo" :: Predicate String)+          `shouldBe` "contains /foo/"+        show (containsCaseInsensitiveRegex "foo" :: Predicate String)+          `shouldBe` "contains /foo/i"+        show (isEmpty :: Predicate [()]) `shouldBe` "empty"+        show (nonEmpty :: Predicate [()]) `shouldBe` "non-empty"+        show (sizeIs (gt 5) :: Predicate [()]) `shouldBe` "size > 5"+        show (elemsAre [gt 5, eq 5] :: Predicate [Int]) `shouldBe` "[> 5,5]"+        show (unorderedElemsAre [gt 5, eq 5] :: Predicate [Int])+          `shouldBe` "(any order) [> 5,5]"+        show (each (gt 5) :: Predicate [Int]) `shouldBe` "each (> 5)"+        show (contains (gt 5) :: Predicate [Int]) `shouldBe` "contains (> 5)"+        show (containsAll [gt 5] :: Predicate [Int])+          `shouldBe` "contains all of [> 5]"+        show (containsOnly [gt 5] :: Predicate [Int])+          `shouldBe` "contains only [> 5]"+        show (keys (contains (eq "foo")) :: Predicate [(String, String)])+          `shouldBe` "keys (contains (\"foo\"))"+        show+          ( contains (eq "foo" `zipP` eq "bar") ::+              Predicate [(String, String)]+          )+          `shouldBe` "contains ((\"foo\",\"bar\"))"+        show+          ( keys (unorderedElemsAre [eq 1, eq 2, eq 3]) ::+              Predicate [(Int, String)]+          )+          `shouldBe` "keys ((any order) [1,2,3])"+        show+          (values (elemsAre [eq "one", eq "two"]) :: Predicate [(Int, String)])+          `shouldBe` "values ([\"one\",\"two\"])"+        show (approxEq 1.0 :: Predicate Double) `shouldBe` "≈ 1.0"+        show (finite :: Predicate Double) `shouldBe` "finite"+        show (infinite :: Predicate Double) `shouldBe` "infinite"+        show (positive :: Predicate Double) `shouldBe` "positive"+        show (negative :: Predicate Double) `shouldBe` "negative"+        show (nonPositive :: Predicate Double) `shouldBe` "non-positive"+        show (nonNegative :: Predicate Double) `shouldBe` "non-negative"+        show (nAn :: Predicate Double) `shouldBe` "NaN"+        show (is even :: Predicate Int)+          `shouldSatisfy` ("custom predicate at " `isPrefixOf`)+        show ($(qIs [|even|]) :: Predicate Int) `shouldBe` "even"+        show (with length (gt 5) :: Predicate String)+          `shouldSatisfy` ("property at " `isPrefixOf`)+        show ($(qWith [|length|]) (gt 5) :: Predicate String)+          `shouldBe` "length: > 5"++    it "matches patterns" $+      example $ do+        let p = $(qMatch [p|Just (Left _)|])+        show p `shouldBe` "Just (Left _)"++        accept p (Just (Left "foo")) `shouldBe` True+        accept p (Just (Right "foo")) `shouldBe` False+        accept p Nothing `shouldBe` False++    it "checks types" $+      example $ do+        let p1 :: Typeable a => Predicate a+            p1 = typed @String anything++            p2 :: Typeable a => Predicate a+            p2 = typed @String (eq "foo")++        show (p1 :: Predicate String)+          `shouldBe` "anything :: [Char]"+        show (p1 :: Predicate Int)+          `shouldBe` "anything :: [Char]"++        accept p1 "foo" `shouldBe` True+        accept p1 "bar" `shouldBe` True+        accept p1 () `shouldBe` False+        accept p1 (5 :: Int) `shouldBe` False++        show (p2 :: Predicate String)+          `shouldBe` "\"foo\" :: [Char]"+        show (p2 :: Predicate Int)+          `shouldBe` "\"foo\" :: [Char]"++        accept p2 "foo" `shouldBe` True+        accept p2 "bar" `shouldBe` False+        accept p2 (5 :: Int) `shouldBe` False