{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Test.HMock.Predicates
( Predicate (..),
anything,
eq,
neq,
gt,
geq,
lt,
leq,
just,
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,
containsKey,
containsEntry,
keysAre,
entriesAre,
approxEq,
finite,
infinite,
nAn,
is,
qIs,
with,
qWith,
qMatch,
typed,
)
where
import Data.Char (toUpper)
import Data.Maybe (isJust)
import Data.MonoTraversable
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.HMock.Internal.TH (removeModNames)
import Test.HMock.Internal.Util (choices, isSubsequenceOf, locate, withLoc)
import Text.Regex.TDFA hiding (match)
data Predicate a = Predicate
{ Predicate a -> String
showPredicate :: String,
Predicate a -> a -> Bool
accept :: a -> Bool
}
instance Show (Predicate a) where show :: Predicate a -> String
show = Predicate a -> String
forall a. Predicate a -> String
showPredicate
anything :: Predicate a
anything :: Predicate a
anything =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"anything",
accept :: a -> Bool
accept = Bool -> a -> Bool
forall a b. a -> b -> a
const Bool
True
}
eq :: (Show a, Eq a) => a -> Predicate a
eq :: a -> Predicate a
eq a
x =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = a -> String
forall a. Show a => a -> String
show a
x,
accept :: a -> Bool
accept = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x)
}
neq :: (Show a, Eq a) => a -> Predicate a
neq :: a -> Predicate a
neq a
x =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"≠ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x,
accept :: a -> Bool
accept = (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
x)
}
gt :: (Show a, Ord a) => a -> Predicate a
gt :: a -> Predicate a
gt a
x =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"> " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x,
accept :: a -> Bool
accept = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
x)
}
geq :: (Show a, Ord a) => a -> Predicate a
geq :: a -> Predicate a
geq a
x =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"≥ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x,
accept :: a -> Bool
accept = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
x)
}
lt :: (Show a, Ord a) => a -> Predicate a
lt :: a -> Predicate a
lt a
x =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"< " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x,
accept :: a -> Bool
accept = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
x)
}
leq :: (Show a, Ord a) => a -> Predicate a
leq :: a -> Predicate a
leq a
x =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"≤ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x,
accept :: a -> Bool
accept = (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
x)
}
just :: Predicate a -> Predicate (Maybe a)
just :: Predicate a -> Predicate (Maybe a)
just Predicate a
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"Just (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")",
accept :: Maybe a -> Bool
accept = \case Just a
x -> Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p a
x; Maybe a
_ -> Bool
False
}
left :: Predicate a -> Predicate (Either a b)
left :: Predicate a -> Predicate (Either a b)
left Predicate a
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"Left (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")",
accept :: Either a b -> Bool
accept = \case Left a
x -> Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p a
x; Either a b
_ -> Bool
False
}
right :: Predicate b -> Predicate (Either a b)
right :: Predicate b -> Predicate (Either a b)
right Predicate b
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"Right (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate b -> String
forall a. Predicate a -> String
showPredicate Predicate b
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")",
accept :: Either a b -> Bool
accept = \case Right b
x -> Predicate b -> b -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate b
p b
x; Either a b
_ -> Bool
False
}
zipP :: Predicate a -> Predicate b -> Predicate (a, b)
zipP :: Predicate a -> Predicate b -> Predicate (a, b)
zipP Predicate a
p Predicate b
q =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = (Predicate a, Predicate b) -> String
forall a. Show a => a -> String
show (Predicate a
p, Predicate b
q),
accept :: (a, b) -> Bool
accept = \(a
x, b
y) -> Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p a
x Bool -> Bool -> Bool
&& Predicate b -> b -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate b
q b
y
}
zip3P :: Predicate a -> Predicate b -> Predicate c -> Predicate (a, b, c)
zip3P :: Predicate a -> Predicate b -> Predicate c -> Predicate (a, b, c)
zip3P Predicate a
p1 Predicate b
p2 Predicate c
p3 =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = (Predicate a, Predicate b, Predicate c) -> String
forall a. Show a => a -> String
show (Predicate a
p1, Predicate b
p2, Predicate c
p3),
accept :: (a, b, c) -> Bool
accept = \(a
x1, b
x2, c
x3) -> Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p1 a
x1 Bool -> Bool -> Bool
&& Predicate b -> b -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate b
p2 b
x2 Bool -> Bool -> Bool
&& Predicate c -> c -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate c
p3 c
x3
}
zip4P ::
Predicate a ->
Predicate b ->
Predicate c ->
Predicate d ->
Predicate (a, b, c, d)
zip4P :: Predicate a
-> Predicate b
-> Predicate c
-> Predicate d
-> Predicate (a, b, c, d)
zip4P Predicate a
p1 Predicate b
p2 Predicate c
p3 Predicate d
p4 =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = (Predicate a, Predicate b, Predicate c, Predicate d) -> String
forall a. Show a => a -> String
show (Predicate a
p1, Predicate b
p2, Predicate c
p3, Predicate d
p4),
accept :: (a, b, c, d) -> Bool
accept = \(a
x1, b
x2, c
x3, d
x4) ->
Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p1 a
x1 Bool -> Bool -> Bool
&& Predicate b -> b -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate b
p2 b
x2 Bool -> Bool -> Bool
&& Predicate c -> c -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate c
p3 c
x3 Bool -> Bool -> Bool
&& Predicate d -> d -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate d
p4 d
x4
}
zip5P ::
Predicate a ->
Predicate b ->
Predicate c ->
Predicate d ->
Predicate e ->
Predicate (a, b, c, d, e)
zip5P :: Predicate a
-> Predicate b
-> Predicate c
-> Predicate d
-> Predicate e
-> Predicate (a, b, c, d, e)
zip5P Predicate a
p1 Predicate b
p2 Predicate c
p3 Predicate d
p4 Predicate e
p5 =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = (Predicate a, Predicate b, Predicate c, Predicate d, Predicate e)
-> String
forall a. Show a => a -> String
show (Predicate a
p1, Predicate b
p2, Predicate c
p3, Predicate d
p4, Predicate e
p5),
accept :: (a, b, c, d, e) -> Bool
accept = \(a
x1, b
x2, c
x3, d
x4, e
x5) ->
Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p1 a
x1 Bool -> Bool -> Bool
&& Predicate b -> b -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate b
p2 b
x2 Bool -> Bool -> Bool
&& Predicate c -> c -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate c
p3 c
x3 Bool -> Bool -> Bool
&& Predicate d -> d -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate d
p4 d
x4
Bool -> Bool -> Bool
&& Predicate e -> e -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate e
p5 e
x5
}
andP :: Predicate a -> Predicate a -> Predicate a
Predicate a
p andP :: Predicate a -> Predicate a -> Predicate a
`andP` Predicate a
q =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" and " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
q,
accept :: a -> Bool
accept = \a
x -> Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p a
x Bool -> Bool -> Bool
&& Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
q a
x
}
orP :: Predicate a -> Predicate a -> Predicate a
Predicate a
p orP :: Predicate a -> Predicate a -> Predicate a
`orP` Predicate a
q =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" or " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
q,
accept :: a -> Bool
accept = \a
x -> Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p a
x Bool -> Bool -> Bool
|| Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
q a
x
}
notP :: Predicate a -> Predicate a
notP :: Predicate a -> Predicate a
notP Predicate a
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"not " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
p,
accept :: a -> Bool
accept = Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p
}
startsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
startsWith :: t -> Predicate t
startsWith t
pfx =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"starts with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
pfx,
accept :: t -> Bool
accept = (t
pfx t -> t -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`Seq.isPrefixOf`)
}
endsWith :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
endsWith :: t -> Predicate t
endsWith t
sfx =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"ends with " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
sfx,
accept :: t -> Bool
accept = (t
sfx t -> t -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`Seq.isSuffixOf`)
}
hasSubstr :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
hasSubstr :: t -> Predicate t
hasSubstr t
s =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"has substring " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
s,
accept :: t -> Bool
accept = (t
s t -> t -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`Seq.isInfixOf`)
}
hasSubsequence :: (Show t, Seq.IsSequence t, Eq (Element t)) => t -> Predicate t
hasSubsequence :: t -> Predicate t
hasSubsequence t
s =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"has subsequence " String -> ShowS
forall a. [a] -> [a] -> [a]
++ t -> String
forall a. Show a => a -> String
show t
s,
accept :: t -> Bool
accept = (t
s t -> t -> Bool
forall seq.
(IsSequence seq, Eq (Element seq)) =>
seq -> seq -> Bool
`isSubsequenceOf`)
}
caseInsensitive ::
( MonoFunctor t,
MonoFunctor a,
Element t ~ Char,
Element a ~ Char
) =>
(t -> Predicate a) ->
(t -> Predicate a)
caseInsensitive :: (t -> Predicate a) -> t -> Predicate a
caseInsensitive t -> Predicate a
p t
s =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"(case insensitive) " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate a -> String
forall a. Show a => a -> String
show (t -> Predicate a
p t
s),
accept :: a -> Bool
accept = Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
capP (a -> Bool) -> (a -> a) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element a -> Element a) -> a -> a
forall mono.
MonoFunctor mono =>
(Element mono -> Element mono) -> mono -> mono
omap Char -> Char
Element a -> Element a
toUpper
}
where
capP :: Predicate a
capP = t -> Predicate a
p ((Element t -> Element t) -> t -> t
forall mono.
MonoFunctor mono =>
(Element mono -> Element mono) -> mono -> mono
omap Char -> Char
Element t -> Element t
toUpper t
s)
matchesRegex :: (RegexLike Regex a, Eq a) => String -> Predicate a
matchesRegex :: String -> Predicate a
matchesRegex String
s =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
init (ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/",
accept :: a -> Bool
accept = \a
x -> case Regex -> a -> Maybe (a, MatchText a, a)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText Regex
r a
x of
Just (a
a, MatchText a
_, a
b) -> a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall source. Extract source => source
empty Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall source. Extract source => source
empty
Maybe (a, MatchText a, a)
Nothing -> Bool
False
}
where
r :: Regex
r = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
comp ExecOption
exec String
s :: Regex
comp :: CompOption
comp = CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt {newSyntax :: Bool
newSyntax = Bool
True, lastStarGreedy :: Bool
lastStarGreedy = Bool
True}
exec :: ExecOption
exec = ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt {captureGroups :: Bool
captureGroups = Bool
False}
matchesCaseInsensitiveRegex ::
(RegexLike Regex a, Eq a) => String -> Predicate a
matchesCaseInsensitiveRegex :: String -> Predicate a
matchesCaseInsensitiveRegex String
s =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
init (ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/i",
accept :: a -> Bool
accept = \a
x -> case Regex -> a -> Maybe (a, MatchText a, a)
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe (source, MatchText source, source)
matchOnceText Regex
r a
x of
Just (a
a, MatchText a
_, a
b) -> a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall source. Extract source => source
empty Bool -> Bool -> Bool
&& a
b a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
forall source. Extract source => source
empty
Maybe (a, MatchText a, a)
Nothing -> Bool
False
}
where
r :: Regex
r = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
comp ExecOption
exec String
s :: Regex
comp :: CompOption
comp =
CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt
{ newSyntax :: Bool
newSyntax = Bool
True,
lastStarGreedy :: Bool
lastStarGreedy = Bool
True,
caseSensitive :: Bool
caseSensitive = Bool
False
}
exec :: ExecOption
exec = ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt {captureGroups :: Bool
captureGroups = Bool
False}
containsRegex :: (RegexLike Regex a, Eq a) => String -> Predicate a
containsRegex :: String -> Predicate a
containsRegex String
s =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"contains /" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
init (ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/",
accept :: a -> Bool
accept = Maybe MatchArray -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MatchArray -> Bool) -> (a -> Maybe MatchArray) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> a -> Maybe MatchArray
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe MatchArray
matchOnce Regex
r
}
where
r :: Regex
r = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
comp ExecOption
exec String
s :: Regex
comp :: CompOption
comp = CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt {newSyntax :: Bool
newSyntax = Bool
True, lastStarGreedy :: Bool
lastStarGreedy = Bool
True}
exec :: ExecOption
exec = ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt {captureGroups :: Bool
captureGroups = Bool
False}
containsCaseInsensitiveRegex ::
(RegexLike Regex a, Eq a) => String -> Predicate a
containsCaseInsensitiveRegex :: String -> Predicate a
containsCaseInsensitiveRegex String
s =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"contains /" String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. [a] -> [a]
init (ShowS
forall a. [a] -> [a]
tail ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
s) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/i",
accept :: a -> Bool
accept = Maybe MatchArray -> Bool
forall a. Maybe a -> Bool
isJust (Maybe MatchArray -> Bool) -> (a -> Maybe MatchArray) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Regex -> a -> Maybe MatchArray
forall regex source.
RegexLike regex source =>
regex -> source -> Maybe MatchArray
matchOnce Regex
r
}
where
r :: Regex
r = CompOption -> ExecOption -> String -> Regex
forall regex compOpt execOpt source.
RegexMaker regex compOpt execOpt source =>
compOpt -> execOpt -> source -> regex
makeRegexOpts CompOption
comp ExecOption
exec String
s :: Regex
comp :: CompOption
comp =
CompOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
compOpt
defaultCompOpt
{ newSyntax :: Bool
newSyntax = Bool
True,
lastStarGreedy :: Bool
lastStarGreedy = Bool
True,
caseSensitive :: Bool
caseSensitive = Bool
False
}
exec :: ExecOption
exec = ExecOption
forall regex compOpt execOpt.
RegexOptions regex compOpt execOpt =>
execOpt
defaultExecOpt {captureGroups :: Bool
captureGroups = Bool
False}
isEmpty :: MonoFoldable t => Predicate t
isEmpty :: Predicate t
isEmpty =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"empty",
accept :: t -> Bool
accept = t -> Bool
forall mono. MonoFoldable mono => mono -> Bool
onull
}
nonEmpty :: MonoFoldable t => Predicate t
nonEmpty :: Predicate t
nonEmpty =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"nonempty",
accept :: t -> Bool
accept = Bool -> Bool
not (Bool -> Bool) -> (t -> Bool) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Bool
forall mono. MonoFoldable mono => mono -> Bool
onull
}
sizeIs :: MonoFoldable t => Predicate Int -> Predicate t
sizeIs :: Predicate Int -> Predicate t
sizeIs Predicate Int
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"size " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate Int -> String
forall a. Predicate a -> String
showPredicate Predicate Int
p,
accept :: t -> Bool
accept = Predicate Int -> Int -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate Int
p (Int -> Bool) -> (t -> Int) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Int
forall mono. MonoFoldable mono => mono -> Int
olength
}
elemsAre :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
elemsAre :: [Predicate (Element t)] -> Predicate t
elemsAre [Predicate (Element t)]
ps =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = [Predicate (Element t)] -> String
forall a. Show a => a -> String
show [Predicate (Element t)]
ps,
accept :: t -> Bool
accept = \t
xs ->
t -> Int
forall mono. MonoFoldable mono => mono -> Int
olength t
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Predicate (Element t)] -> Int
forall mono. MonoFoldable mono => mono -> Int
olength [Predicate (Element t)]
ps
Bool -> Bool -> Bool
&& [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ((Predicate (Element t) -> Element t -> Bool)
-> [Predicate (Element t)] -> [Element t] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Predicate (Element t) -> Element t -> Bool
forall a. Predicate a -> a -> Bool
accept [Predicate (Element t)]
ps (t -> [Element t]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList t
xs))
}
unorderedElemsAre :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
unorderedElemsAre :: [Predicate (Element t)] -> Predicate t
unorderedElemsAre [Predicate (Element t)]
ps =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate =
String
"(any order) " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Predicate (Element t)] -> String
forall a. Show a => a -> String
show [Predicate (Element t)]
ps,
accept :: t -> Bool
accept = [Predicate (Element t)] -> [Element t] -> Bool
forall a. [Predicate a] -> [a] -> Bool
matches [Predicate (Element t)]
ps ([Element t] -> Bool) -> (t -> [Element t]) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [Element t]
forall mono. MonoFoldable mono => mono -> [Element mono]
otoList
}
where
matches :: [Predicate a] -> [a] -> Bool
matches (Predicate a
q : [Predicate a]
qs) [a]
xs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [[Predicate a] -> [a] -> Bool
matches [Predicate a]
qs [a]
ys | (a
y, [a]
ys) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
choices [a]
xs, Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
q a
y]
matches [] [a]
xs = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
each :: MonoFoldable t => Predicate (Element t) -> Predicate t
each :: Predicate (Element t) -> Predicate t
each Predicate (Element t)
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"each (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate (Element t) -> String
forall a. Predicate a -> String
showPredicate Predicate (Element t)
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")",
accept :: t -> Bool
accept = (Element t -> Bool) -> t -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oall (Predicate (Element t) -> Element t -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate (Element t)
p)
}
contains :: MonoFoldable t => Predicate (Element t) -> Predicate t
contains :: Predicate (Element t) -> Predicate t
contains Predicate (Element t)
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"contains (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate (Element t) -> String
forall a. Predicate a -> String
showPredicate Predicate (Element t)
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")",
accept :: t -> Bool
accept = (Element t -> Bool) -> t -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oany (Predicate (Element t) -> Element t -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate (Element t)
p)
}
containsAll :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
containsAll :: [Predicate (Element t)] -> Predicate t
containsAll [Predicate (Element t)]
ps =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"contains all of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Predicate (Element t)] -> String
forall a. Show a => a -> String
show [Predicate (Element t)]
ps,
accept :: t -> Bool
accept = \t
xs -> (Predicate (Element t) -> Bool) -> [Predicate (Element t)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (((Element t -> Bool) -> t -> Bool)
-> t -> (Element t -> Bool) -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Element t -> Bool) -> t -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oany t
xs ((Element t -> Bool) -> Bool)
-> (Predicate (Element t) -> Element t -> Bool)
-> Predicate (Element t)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Predicate (Element t) -> Element t -> Bool
forall a. Predicate a -> a -> Bool
accept) [Predicate (Element t)]
ps
}
containsOnly :: MonoFoldable t => [Predicate (Element t)] -> Predicate t
containsOnly :: [Predicate (Element t)] -> Predicate t
containsOnly [Predicate (Element t)]
ps =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"contains only " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Predicate (Element t)] -> String
forall a. Show a => a -> String
show [Predicate (Element t)]
ps,
accept :: t -> Bool
accept = (Element t -> Bool) -> t -> Bool
forall mono.
MonoFoldable mono =>
(Element mono -> Bool) -> mono -> Bool
oall (\Element t
x -> (Predicate (Element t) -> Bool) -> [Predicate (Element t)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Predicate (Element t) -> Element t -> Bool
forall a. Predicate a -> a -> Bool
`accept` Element t
x) [Predicate (Element t)]
ps)
}
containsKey :: (IsList t, Item t ~ (k, v)) => Predicate k -> Predicate t
containsKey :: Predicate k -> Predicate t
containsKey Predicate k
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"contains key " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate k -> String
forall a. Show a => a -> String
show Predicate k
p,
accept :: t -> Bool
accept = \t
m -> (k -> Bool) -> [k] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Predicate k -> k -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate k
p) ((k, v) -> k
forall a b. (a, b) -> a
fst ((k, v) -> k) -> [(k, v)] -> [k]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> [Item t]
forall l. IsList l => l -> [Item l]
toList t
m)
}
containsEntry ::
(IsList t, Item t ~ (k, v)) => Predicate k -> Predicate v -> Predicate t
containsEntry :: Predicate k -> Predicate v -> Predicate t
containsEntry Predicate k
p Predicate v
q =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"contains entry " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Predicate k, Predicate v) -> String
forall a. Show a => a -> String
show (Predicate k
p, Predicate v
q),
accept :: t -> Bool
accept = ((k, v) -> Bool) -> [(k, v)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(k
x, v
y) -> Predicate k -> k -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate k
p k
x Bool -> Bool -> Bool
&& Predicate v -> v -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate v
q v
y) ([(k, v)] -> Bool) -> (t -> [(k, v)]) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [(k, v)]
forall l. IsList l => l -> [Item l]
toList
}
keysAre ::
(IsList t, Item t ~ (k, v)) => [Predicate k] -> Predicate t
keysAre :: [Predicate k] -> Predicate t
keysAre [Predicate k]
ps =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"keys are " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Predicate k] -> String
forall a. Show a => a -> String
show [Predicate k]
ps,
accept :: t -> Bool
accept = [Predicate k] -> [k] -> Bool
forall a. [Predicate a] -> [a] -> Bool
matches [Predicate k]
ps ([k] -> Bool) -> (t -> [k]) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> k) -> [(k, v)] -> [k]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> k
forall a b. (a, b) -> a
fst ([(k, v)] -> [k]) -> (t -> [(k, v)]) -> t -> [k]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [(k, v)]
forall l. IsList l => l -> [Item l]
toList
}
where
matches :: [Predicate a] -> [a] -> Bool
matches (Predicate a
q : [Predicate a]
qs) [a]
xs = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [[Predicate a] -> [a] -> Bool
matches [Predicate a]
qs [a]
ys | (a
y, [a]
ys) <- [a] -> [(a, [a])]
forall a. [a] -> [(a, [a])]
choices [a]
xs, Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
q a
y]
matches [] [a]
xs = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [a]
xs
entriesAre ::
(IsList t, Item t ~ (k, v)) => [(Predicate k, Predicate v)] -> Predicate t
entriesAre :: [(Predicate k, Predicate v)] -> Predicate t
entriesAre [(Predicate k, Predicate v)]
ps =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"entries are " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [(Predicate k, Predicate v)] -> String
forall a. Show a => a -> String
show [(Predicate k, Predicate v)]
ps,
accept :: t -> Bool
accept = [(Predicate k, Predicate v)] -> [(k, v)] -> Bool
forall a a. [(Predicate a, Predicate a)] -> [(a, a)] -> Bool
matches [(Predicate k, Predicate v)]
ps ([(k, v)] -> Bool) -> (t -> [(k, v)]) -> t -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [(k, v)]
forall l. IsList l => l -> [Item l]
toList
}
where
matches :: [(Predicate a, Predicate a)] -> [(a, a)] -> Bool
matches ((Predicate a
p, Predicate a
q) : [(Predicate a, Predicate a)]
pqs) [(a, a)]
xs =
[Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [[(Predicate a, Predicate a)] -> [(a, a)] -> Bool
matches [(Predicate a, Predicate a)]
pqs [(a, a)]
ys | ((a
k, a
v), [(a, a)]
ys) <- [(a, a)] -> [((a, a), [(a, a)])]
forall a. [a] -> [(a, [a])]
choices [(a, a)]
xs, Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p a
k, Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
q a
v]
matches [] [(a, a)]
xs = [(a, a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(a, a)]
xs
approxEq :: (RealFloat a, Show a) => a -> Predicate a
approxEq :: a -> Predicate a
approxEq a
x =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"≈ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
x,
accept :: a -> Bool
accept = \a
y -> a -> a
forall a. Num a => a -> a
abs (a
x a -> a -> a
forall a. Num a => a -> a -> a
- a
y) a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
diff
}
where
diff :: a
diff = Integer -> Int -> a
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
1 ((Integer, Int) -> Int
forall a b. (a, b) -> b
snd (a -> (Integer, Int)
forall a. RealFloat a => a -> (Integer, Int)
decodeFloat a
x) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ a -> Int
forall a. RealFloat a => a -> Int
floatDigits a
x Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2)
finite :: RealFloat a => Predicate a
finite :: Predicate a
finite =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"finite",
accept :: a -> Bool
accept = \a
x -> Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite a
x) Bool -> Bool -> Bool
&& Bool -> Bool
not (a -> Bool
forall a. RealFloat a => a -> Bool
isNaN a
x)
}
infinite :: RealFloat a => Predicate a
infinite :: Predicate a
infinite =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"infinite",
accept :: a -> Bool
accept = a -> Bool
forall a. RealFloat a => a -> Bool
isInfinite
}
nAn :: RealFloat a => Predicate a
nAn :: Predicate a
nAn =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = String
"NaN",
accept :: a -> Bool
accept = a -> Bool
forall a. RealFloat a => a -> Bool
isNaN
}
is :: HasCallStack => (a -> Bool) -> Predicate a
is :: (a -> Bool) -> Predicate a
is a -> Bool
f =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate = Located String -> String
withLoc (CallStack -> String -> Located String
forall a. CallStack -> a -> Located a
locate CallStack
HasCallStack => CallStack
callStack String
"custom predicate"),
accept :: a -> Bool
accept = a -> Bool
f
}
qIs :: HasCallStack => ExpQ -> ExpQ
qIs :: ExpQ -> ExpQ
qIs ExpQ
f =
[|
Predicate
{ showPredicate = $(lift . pprint . removeModNames =<< f),
accept = $f
}
|]
with :: HasCallStack => (a -> b) -> Predicate b -> Predicate a
with :: (a -> b) -> Predicate b -> Predicate a
with a -> b
f Predicate b
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate =
Located String -> String
withLoc (CallStack -> String -> Located String
forall a. CallStack -> a -> Located a
locate CallStack
HasCallStack => CallStack
callStack String
"property") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Predicate b -> String
forall a. Show a => a -> String
show Predicate b
p,
accept :: a -> Bool
accept = Predicate b -> b -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate b
p (b -> Bool) -> (a -> b) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
}
qWith :: ExpQ -> ExpQ
qWith :: ExpQ -> ExpQ
qWith ExpQ
f =
[|
\p ->
Predicate
{ showPredicate =
$(lift . pprint . removeModNames =<< f) ++ ": " ++ show p,
accept = accept p . $f
}
|]
qMatch :: PatQ -> ExpQ
qMatch :: PatQ -> ExpQ
qMatch PatQ
qpat =
[|
Predicate
{ showPredicate = $(lift . pprint . removeModNames =<< qpat),
accept = \case
$(qpat) -> True
_ -> False
}
|]
typed :: forall a b. (Typeable a, Typeable b) => Predicate a -> Predicate b
typed :: Predicate a -> Predicate b
typed Predicate a
p =
Predicate :: forall a. String -> (a -> Bool) -> Predicate a
Predicate
{ showPredicate :: String
showPredicate =
Predicate a -> String
forall a. Predicate a -> String
showPredicate Predicate a
p String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" :: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (Proxy a -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)),
accept :: b -> Bool
accept = \b
x -> case b -> Maybe a
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast b
x of
Maybe a
Nothing -> Bool
False
Just a
y -> Predicate a -> a -> Bool
forall a. Predicate a -> a -> Bool
accept Predicate a
p a
y
}