{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Test.Tasty.Sugar.ExpectCheck
(
findExpectation
, collateExpectations
)
where
import Control.Applicative ( (<|>) )
import Control.Monad
import Data.Bifunctor ( first )
import Data.Function ( on )
import qualified Data.List as L
import Data.Maybe ( isNothing )
import Test.Tasty.Sugar.AssocCheck
import Test.Tasty.Sugar.Candidates
import Test.Tasty.Sugar.Iterations
import Test.Tasty.Sugar.ParamCheck
import Test.Tasty.Sugar.Types
findExpectation :: CUBE
-> [ParameterPattern]
-> CandidateFile
-> [CandidateFile]
-> ([NamedParamMatch], CandidateFile)
-> (Maybe ( Sweets, SweetExplanation ), IterStat)
findExpectation :: CUBE
-> [ParameterPattern]
-> CandidateFile
-> [CandidateFile]
-> ([NamedParamMatch], CandidateFile)
-> (Maybe (Sweets, SweetExplanation), IterStat)
findExpectation CUBE
pat [ParameterPattern]
params CandidateFile
rootN [CandidateFile]
allNames ([NamedParamMatch]
rootPMatches, CandidateFile
matchPrefix) =
let r :: (Maybe Sweets, IterStat)
r = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Expectation] -> Maybe Sweets
mkSweet forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expectation] -> [Expectation]
trimExpectations)
forall a b. (a -> b) -> a -> b
$ forall a. LogicI a -> ([a], IterStat)
observeIAll
forall a b. (a -> b) -> a -> b
$ do forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CandidateFile]
candidates)
CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> String
-> [(String, String)]
-> [CandidateFile]
-> LogicI Expectation
expectedSearch
CandidateFile
matchPrefix
[NamedParamMatch]
rootPMatches
String
seps [ParameterPattern]
params String
expSuffix [(String, String)]
o
[CandidateFile]
candidates
o :: [(String, String)]
o = CUBE -> [(String, String)]
associatedNames CUBE
pat
seps :: String
seps = CUBE -> String
separators CUBE
pat
expSuffix :: String
expSuffix = CUBE -> String
expectedSuffix CUBE
pat
sfxMatch :: String -> Bool
sfxMatch = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
expSuffix then forall a b. a -> b -> a
const Bool
True else (String
expSuffix forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf`)
candidates :: [CandidateFile]
candidates = forall a. (a -> Bool) -> [a] -> [a]
filter CandidateFile -> Bool
possible [CandidateFile]
allNames
possible :: CandidateFile -> Bool
possible CandidateFile
f = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ CandidateFile -> String
candidateFile CandidateFile
matchPrefix forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` CandidateFile -> String
candidateFile CandidateFile
f
, CandidateFile
rootN forall a. Eq a => a -> a -> Bool
/= CandidateFile
f
]
mkSweet :: [Expectation] -> Maybe Sweets
mkSweet [Expectation]
e = forall a. a -> Maybe a
Just
forall a b. (a -> b) -> a -> b
$ Sweets { rootMatchName :: String
rootMatchName = CandidateFile -> String
candidateFile CandidateFile
rootN
, rootBaseName :: String
rootBaseName = CandidateFile -> String
candidateFile CandidateFile
matchPrefix
, rootFile :: String
rootFile = CandidateFile -> String
candidateToPath CandidateFile
rootN
, cubeParams :: [ParameterPattern]
cubeParams = CUBE -> [ParameterPattern]
validParams CUBE
pat
, expected :: [Expectation]
expected = forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> String
expectedFile) [Expectation]
e
}
trimExpectations :: [Expectation] -> [Expectation]
trimExpectations :: [Expectation] -> [Expectation]
trimExpectations =
[Expectation] -> [Expectation]
collateExpectations
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
L.nub
in case (Maybe Sweets, IterStat)
r of
(Maybe Sweets
Nothing, IterStat
stats) -> (forall a. Maybe a
Nothing, IterStat
stats)
(Just Sweets
r', IterStat
stats) | [] <- Sweets -> [Expectation]
expected Sweets
r' -> (forall a. Maybe a
Nothing, IterStat
stats)
(Just Sweets
r', IterStat
stats) ->
( forall a. a -> Maybe a
Just ( Sweets
r'
, SweetExpl { rootPath :: String
rootPath = CandidateFile -> String
candidateToPath CandidateFile
rootN
, base :: String
base = CandidateFile -> String
candidateToPath CandidateFile
matchPrefix
, expectedNames :: [String]
expectedNames =
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
sfxMatch (CandidateFile -> String
candidateToPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CandidateFile]
candidates)
, results :: Sweets
results = Sweets
r'
})
, IterStat
stats )
expectedSearch :: CandidateFile
-> [NamedParamMatch]
-> Separators
-> [ParameterPattern]
-> FileSuffix
-> [ (String, FileSuffix) ]
-> [CandidateFile]
-> LogicI Expectation
expectedSearch :: CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> String
-> [(String, String)]
-> [CandidateFile]
-> LogicI Expectation
expectedSearch CandidateFile
rootPrefix [NamedParamMatch]
rootPVMatches String
seps [ParameterPattern]
params String
expSuffix [(String, String)]
assocNames [CandidateFile]
allNames =
do let expMatch :: CandidateFile -> Bool
expMatch CandidateFile
cf = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ String -> CandidateFile -> CandidateFile -> Bool
candidateMatchPrefix String
seps CandidateFile
rootPrefix CandidateFile
cf
, String -> String -> CandidateFile -> CandidateFile -> Bool
candidateMatchSuffix String
seps String
expSuffix CandidateFile
rootPrefix CandidateFile
cf
]
let unconstrained :: [String]
unconstrained = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Bool) -> [a] -> [a]
L.filter (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [ParameterPattern]
params
([NamedParamMatch]
rmatch, [(String, Maybe String)]
pvals) <- [NamedParamMatch]
-> [ParameterPattern]
-> LogicT
(StateT IterStat Identity)
([NamedParamMatch], [(String, Maybe String)])
getSinglePVals [NamedParamMatch]
rootPVMatches [ParameterPattern]
params
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unconstrained
then forall (m :: * -> *) a. MonadPlus m => m a
mzero
else let unConstr :: (String, b) -> Bool
unConstr = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
unconstrained) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
rm :: [NamedParamMatch]
rm = forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. (String, b) -> Bool
unConstr) [NamedParamMatch]
rootPVMatches
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NamedParamMatch]
rm
then forall (m :: * -> *) a. MonadPlus m => m a
mzero
else [NamedParamMatch]
-> [ParameterPattern]
-> LogicT
(StateT IterStat Identity)
([NamedParamMatch], [(String, Maybe String)])
getSinglePVals [NamedParamMatch]
rm [ParameterPattern]
params
)
CandidateFile
efile <- forall a. Text -> [a] -> LogicI a
eachFrom Text
"exp candidate"
forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse
forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [ParamMatch] -> Natural
matchStrength forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CandidateFile -> [NamedParamMatch]
candidatePMatch)
forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter CandidateFile -> Bool
expMatch [CandidateFile]
allNames
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ [(String, Maybe String)] -> CandidateFile -> Bool
isCompatible [(String, Maybe String)]
pvals CandidateFile
efile
let onlyOneOfEach :: (a, b) -> [(a, b)] -> [(a, b)]
onlyOneOfEach (a
p,b
v) [(a, b)]
r = case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
p [(a, b)]
r of
Maybe b
Nothing -> (a
p,b
v) forall a. a -> [a] -> [a]
: [(a, b)]
r
Just b
_ -> [(a, b)]
r
[NamedParamMatch]
rAndeMatches <- forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
onlyOneOfEach [NamedParamMatch]
rmatch (CandidateFile -> [NamedParamMatch]
candidatePMatch CandidateFile
efile))
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unconstrained
then forall (m :: * -> *) a. MonadPlus m => m a
mzero
else let unConstr :: (String, b) -> Bool
unConstr = (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
unconstrained) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
rm :: [NamedParamMatch]
rm = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. (String, b) -> Bool
unConstr) (CandidateFile -> [NamedParamMatch]
candidatePMatch CandidateFile
efile)
in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NamedParamMatch]
rm
then forall (m :: * -> *) a. MonadPlus m => m a
mzero
else forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {b}. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
onlyOneOfEach [NamedParamMatch]
rmatch [NamedParamMatch]
rm)
)
let pmatch :: [NamedParamMatch]
pmatch = [NamedParamMatch] -> [(String, Maybe String)] -> [NamedParamMatch]
namedPMatches [NamedParamMatch]
rAndeMatches [(String, Maybe String)]
pvals
[(String, CandidateFile)]
assocFiles <- CandidateFile
-> String
-> [NamedParamMatch]
-> [(String, String)]
-> [CandidateFile]
-> LogicI [(String, CandidateFile)]
getAssoc CandidateFile
rootPrefix String
seps
[NamedParamMatch]
pmatch
[(String, String)]
assocNames [CandidateFile]
allNames
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Expectation { expectedFile :: String
expectedFile = CandidateFile -> String
candidateToPath CandidateFile
efile
, associated :: [(String, String)]
associated = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CandidateFile -> String
candidateToPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, CandidateFile)]
assocFiles
, expParamsMatch :: [NamedParamMatch]
expParamsMatch = forall a. Ord a => [a] -> [a]
L.sort [NamedParamMatch]
pmatch
}
collateExpectations :: [Expectation] -> [Expectation]
collateExpectations :: [Expectation] -> [Expectation]
collateExpectations [Expectation]
allExps =
let paramsAndVals :: Expectation -> [(String, Maybe String)]
paramsAndVals = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParamMatch -> Maybe String
getParamVal)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> [NamedParamMatch]
expParamsMatch
pvMatch :: [(a, a)] -> [(a, a)] -> Bool
pvMatch [(a, a)]
a [(a, a)]
b =
let pvCmp :: [(a, a)] -> [(a, a)] -> Bool
pvCmp [(a, a)]
_ [] = Bool
True
pvCmp ((a
xn,a
xv):[(a, a)]
xs) y :: [(a, a)]
y@((a
yn,a
yv):[(a, a)]
ys) =
if a
xn forall a. Eq a => a -> a -> Bool
== a
yn
then a
xv forall a. Eq a => a -> a -> Bool
== a
yv Bool -> Bool -> Bool
&& [(a, a)] -> [(a, a)] -> Bool
pvCmp [(a, a)]
xs [(a, a)]
ys
else [(a, a)] -> [(a, a)] -> Bool
pvCmp [(a, a)]
xs [(a, a)]
y
pvCmp [] [(a, a)]
_ = forall a. HasCallStack => String -> a
error String
"first argument must be longest list for pvMatch"
in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, a)]
a forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, a)]
b then forall {a} {a}. (Eq a, Eq a) => [(a, a)] -> [(a, a)] -> Bool
pvCmp [(a, a)]
a [(a, a)]
b else forall {a} {a}. (Eq a, Eq a) => [(a, a)] -> [(a, a)] -> Bool
pvCmp [(a, a)]
b [(a, a)]
a
pvCompare :: [(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCompare [(a, ParamMatch)]
a [(a, ParamMatch)]
b =
let pvCmpN :: Int -> [(a, ParamMatch)] -> [(a, ParamMatch)] -> (Int, Ordering)
pvCmpN Int
n [] [] = (Int
n, Ordering
EQ)
pvCmpN Int
n ((a
_,ParamMatch
xv):[(a, ParamMatch)]
xs) [] = forall a b. a -> b -> a
const Ordering
GT forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [(a, ParamMatch)] -> [(a, ParamMatch)] -> (Int, Ordering)
pvCmpN (Int
n forall a. Num a => a -> a -> a
+ ParamMatch -> Int
weight ParamMatch
xv) [(a, ParamMatch)]
xs []
pvCmpN Int
n [] [(a, ParamMatch)]
_ = (Int
n, Ordering
LT)
pvCmpN Int
n ((a
xn,ParamMatch
xv):[(a, ParamMatch)]
xs) y :: [(a, ParamMatch)]
y@((a
yn,ParamMatch
yv):[(a, ParamMatch)]
ys) =
if a
xn forall a. Eq a => a -> a -> Bool
== a
yn
then case forall a. Ord a => a -> a -> Ordering
compare (ParamMatch -> Maybe String
getParamVal ParamMatch
xv) (ParamMatch -> Maybe String
getParamVal ParamMatch
yv) of
Ordering
EQ -> Int -> [(a, ParamMatch)] -> [(a, ParamMatch)] -> (Int, Ordering)
pvCmpN (Int
n forall a. Num a => a -> a -> a
+ ParamMatch -> Int
weight ParamMatch
xv forall a. Num a => a -> a -> a
- ParamMatch -> Int
weight ParamMatch
yv) [(a, ParamMatch)]
xs [(a, ParamMatch)]
ys
Ordering
o -> (Int
n, Ordering
o)
else Int -> [(a, ParamMatch)] -> [(a, ParamMatch)] -> (Int, Ordering)
pvCmpN (Int
n forall a. Num a => a -> a -> a
+ ParamMatch -> Int
weight ParamMatch
xv) [(a, ParamMatch)]
xs [(a, ParamMatch)]
y
pvCmp :: [(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCmp [(a, ParamMatch)]
x [(a, ParamMatch)]
y = case forall {a}.
Eq a =>
Int -> [(a, ParamMatch)] -> [(a, ParamMatch)] -> (Int, Ordering)
pvCmpN (Int
0::Int) [(a, ParamMatch)]
x [(a, ParamMatch)]
y of
(Int
n, Ordering
EQ) -> if Int
n forall a. Ord a => a -> a -> Bool
> Int
0
then Ordering
GT
else if Int
n forall a. Ord a => a -> a -> Bool
< Int
0 then Ordering
LT
else forall a. Ord a => a -> a -> Ordering
compare [(a, ParamMatch)]
x [(a, ParamMatch)]
y
(Int
_, Ordering
o) -> Ordering
o
weight :: ParamMatch -> Int
weight = \case
ParamMatch
NotSpecified -> Int
0
Assumed String
_ -> Int
0
Explicit String
_ -> Int
1
invertCmp :: Ordering -> Ordering
invertCmp = \case
Ordering
LT -> Ordering
GT
Ordering
GT -> Ordering
LT
Ordering
EQ -> Ordering
EQ
in if forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, ParamMatch)]
a forall a. Ord a => a -> a -> Bool
> forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, ParamMatch)]
b
then forall {a}.
Ord a =>
[(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCmp [(a, ParamMatch)]
a [(a, ParamMatch)]
b
else Ordering -> Ordering
invertCmp forall a b. (a -> b) -> a -> b
$ forall {a}.
Ord a =>
[(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCmp [(a, ParamMatch)]
b [(a, ParamMatch)]
a
expGrps :: [[Expectation]]
expGrps = forall {a}. (a -> a -> Bool) -> [a] -> [[a]]
collectBy (forall {a} {a}. (Eq a, Eq a) => [(a, a)] -> [(a, a)] -> Bool
pvMatch forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> [(String, Maybe String)]
paramsAndVals)
forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
L.reverse
forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> [NamedParamMatch]
expParamsMatch))
forall a b. (a -> b) -> a -> b
$ [Expectation]
allExps
collectBy :: (a -> a -> Bool) -> [a] -> [[a]]
collectBy a -> a -> Bool
_ [] = []
collectBy a -> a -> Bool
f (a
e:[a]
es) = let ([a]
s,[a]
d) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (a -> a -> Bool
f a
e) [a]
es
in (a
e forall a. a -> [a] -> [a]
: [a]
s) forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
collectBy a -> a -> Bool
f [a]
d
in
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a. Int -> [a] -> [a]
take Int
1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.reverse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> String
expectedFile))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.reverse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> a
head
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> [NamedParamMatch]
expParamsMatch)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
L.reverse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (forall {a}.
Ord a =>
[(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCompare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> [NamedParamMatch]
expParamsMatch)
) [[Expectation]]
expGrps