{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-deprecations #-}

-- | Function to find expected results files for a specific root file,
-- along with any parameter values identified by the root file.

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


-- | Finds the possible expected files matching the selected
-- source. There will be either one or none.
findExpectation :: CUBE
                -> [ParameterPattern]
                -> CandidateFile   --  original name of source
                -> [CandidateFile] --  all of the names to choose from
                -> ([NamedParamMatch], CandidateFile) -- param constraints from the root name
                -> (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 = ([Expectation] -> Maybe Sweets)
-> ([Expectation], IterStat) -> (Maybe Sweets, IterStat)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Expectation] -> Maybe Sweets
mkSweet ([Expectation] -> Maybe Sweets)
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> Maybe Sweets
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expectation] -> [Expectation]
trimExpectations)
          (([Expectation], IterStat) -> (Maybe Sweets, IterStat))
-> ([Expectation], IterStat) -> (Maybe Sweets, IterStat)
forall a b. (a -> b) -> a -> b
$ LogicI Expectation -> ([Expectation], IterStat)
forall a. LogicI a -> ([a], IterStat)
observeIAll
          (LogicI Expectation -> ([Expectation], IterStat))
-> LogicI Expectation -> ([Expectation], IterStat)
forall a b. (a -> b) -> a -> b
$ do Bool -> LogicT (StateT IterStat Identity) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [CandidateFile] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CandidateFile]
candidates)
               CandidateFile
-> CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> String
-> [(String, String)]
-> [CandidateFile]
-> LogicI Expectation
expectedSearch
                 CandidateFile
rootN
                 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 String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
expSuffix then Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True else (String
expSuffix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf`)
      candidates :: [CandidateFile]
candidates = (CandidateFile -> Bool) -> [CandidateFile] -> [CandidateFile]
forall a. (a -> Bool) -> [a] -> [a]
filter CandidateFile -> Bool
possible [CandidateFile]
allNames
      possible :: CandidateFile -> Bool
possible CandidateFile
f = CandidateFile -> String
candidateFile CandidateFile
matchPrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` CandidateFile -> String
candidateFile CandidateFile
f

      mkSweet :: [Expectation] -> Maybe Sweets
mkSweet [Expectation]
e = Sweets -> Maybe Sweets
forall a. a -> Maybe a
Just
                  (Sweets -> Maybe Sweets) -> Sweets -> Maybe Sweets
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 = (Expectation -> Expectation -> Ordering)
-> [Expectation] -> [Expectation]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (Expectation -> String)
-> Expectation
-> Expectation
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> String
expectedFile) [Expectation]
e
                           }

      -- The expectedSearch tries various combinations and ordering of
      -- parameter values, separators, and such to find all valid
      -- expected file matches.  However, the result is an
      -- over-sampling, so this function trims the excess and unwanted
      -- expectations.
      trimExpectations :: [Expectation] -> [Expectation]
      trimExpectations :: [Expectation] -> [Expectation]
trimExpectations =
        -- If a parameter is Explicitly matched, discard any
        -- Expectation with the same Assumed matches.
        [Expectation] -> [Expectation]
collateExpectations
        -- remove duplicates (uses the Eq instance for Expectation
        -- that ignores the order of the expParamsMatch and associated
        -- to ensure that different ordering with the same values
        -- doesn't cause multiple Expectation.
        ([Expectation] -> [Expectation])
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> [Expectation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expectation] -> [Expectation]
forall a. Eq a => [a] -> [a]
L.nub

  in case (Maybe Sweets, IterStat)
r of
       (Maybe Sweets
Nothing, IterStat
stats) -> (Maybe (Sweets, SweetExplanation)
forall a. Maybe a
Nothing, IterStat
stats)
       (Just Sweets
r', IterStat
stats) | [] <- Sweets -> [Expectation]
expected Sweets
r' -> (Maybe (Sweets, SweetExplanation)
forall a. Maybe a
Nothing, IterStat
stats)
       (Just Sweets
r', IterStat
stats) ->
         ( (Sweets, SweetExplanation) -> Maybe (Sweets, SweetExplanation)
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 =
                                (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
sfxMatch (CandidateFile -> String
candidateToPath (CandidateFile -> String) -> [CandidateFile] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CandidateFile]
candidates)
                            , results :: Sweets
results = Sweets
r'
                            })
         , IterStat
stats )


-- Find all Expectations matching this rootMatch.
--
-- Note that rootPVMatches may contain multiple entries for the same parameter
-- value: the root file name may contain these duplications.  The code here
-- should be careful to check against each value instead of assuming just one.
expectedSearch :: CandidateFile -- ^ actual root file
               -> CandidateFile -- ^ prefix of root file to consider
               -> [NamedParamMatch]
               -> Separators
               -> [ParameterPattern]
               -> FileSuffix
               -> [ (String, FileSuffix) ]
               -> [CandidateFile]
               -> LogicI Expectation
expectedSearch :: CandidateFile
-> CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> String
-> [(String, String)]
-> [CandidateFile]
-> LogicI Expectation
expectedSearch CandidateFile
rootN CandidateFile
rootPrefix [NamedParamMatch]
rootPVMatches String
seps [ParameterPattern]
params String
expSuffix
               [(String, String)]
assocNames [CandidateFile]
allNames =
  do let expMatch :: CandidateFile -> Bool
expMatch CandidateFile
cf = [Bool] -> Bool
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 = ParameterPattern -> String
forall a b. (a, b) -> a
fst (ParameterPattern -> String) -> [ParameterPattern] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParameterPattern -> Bool)
-> [ParameterPattern] -> [ParameterPattern]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Maybe [String] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [String] -> Bool)
-> (ParameterPattern -> Maybe [String]) -> ParameterPattern -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterPattern -> Maybe [String]
forall a b. (a, b) -> b
snd) [ParameterPattern]
params

     -- Get the parameters matched by the root, and suggested values for the
     -- other parameters.  This will backtrack through alternative values for
     -- each parameter.

     ([NamedParamMatch]
rmatch, [(String, Maybe String)]
pvals) <- [NamedParamMatch]
-> [ParameterPattern]
-> LogicI ([NamedParamMatch], [(String, Maybe String)])
getSinglePVals [NamedParamMatch]
rootPVMatches [ParameterPattern]
params
                        -- If some of rootPVMatches were related to values that
                        -- might have been useable for an unconstrained
                        -- parameter, then we also need to consider roots that
                        -- don't match those unconstrained values (because those
                        -- might not be a match for that parameter):
                        LogicI ([NamedParamMatch], [(String, Maybe String)])
-> LogicI ([NamedParamMatch], [(String, Maybe String)])
-> LogicI ([NamedParamMatch], [(String, Maybe String)])
forall a.
LogicT (StateT IterStat Identity) a
-> LogicT (StateT IterStat Identity) a
-> LogicT (StateT IterStat Identity) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                        (if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unconstrained
                          then LogicI ([NamedParamMatch], [(String, Maybe String)])
forall a. LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                          else let unConstr :: (String, b) -> Bool
unConstr = (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
unconstrained) (String -> Bool) -> ((String, b) -> String) -> (String, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, b) -> String
forall a b. (a, b) -> a
fst
                                   rm :: [NamedParamMatch]
rm = (NamedParamMatch -> Bool) -> [NamedParamMatch] -> [NamedParamMatch]
forall a. (a -> Bool) -> [a] -> [a]
L.filter (Bool -> Bool
not (Bool -> Bool)
-> (NamedParamMatch -> Bool) -> NamedParamMatch -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedParamMatch -> Bool
forall {b}. (String, b) -> Bool
unConstr) [NamedParamMatch]
rootPVMatches
                               in if [NamedParamMatch] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NamedParamMatch]
rm
                                  then LogicI ([NamedParamMatch], [(String, Maybe String)])
forall a. LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                                  else [NamedParamMatch]
-> [ParameterPattern]
-> LogicI ([NamedParamMatch], [(String, Maybe String)])
getSinglePVals [NamedParamMatch]
rm [ParameterPattern]
params
                        )

     CandidateFile
efile <- Text -> [CandidateFile] -> LogicI CandidateFile
forall a. Text -> [a] -> LogicI a
eachFrom Text
"exp candidate"
              ([CandidateFile] -> LogicI CandidateFile)
-> [CandidateFile] -> LogicI CandidateFile
forall a b. (a -> b) -> a -> b
$ [CandidateFile] -> [CandidateFile]
forall a. [a] -> [a]
L.reverse
              ([CandidateFile] -> [CandidateFile])
-> [CandidateFile] -> [CandidateFile]
forall a b. (a -> b) -> a -> b
$ (CandidateFile -> CandidateFile -> Ordering)
-> [CandidateFile] -> [CandidateFile]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Natural -> Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Natural -> Natural -> Ordering)
-> (CandidateFile -> Natural)
-> CandidateFile
-> CandidateFile
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` [ParamMatch] -> Natural
matchStrength ([ParamMatch] -> Natural)
-> (CandidateFile -> [ParamMatch]) -> CandidateFile -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedParamMatch -> ParamMatch)
-> [NamedParamMatch] -> [ParamMatch]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedParamMatch -> ParamMatch
forall a b. (a, b) -> b
snd ([NamedParamMatch] -> [ParamMatch])
-> (CandidateFile -> [NamedParamMatch])
-> CandidateFile
-> [ParamMatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CandidateFile -> [NamedParamMatch]
candidatePMatch)
              ([CandidateFile] -> [CandidateFile])
-> [CandidateFile] -> [CandidateFile]
forall a b. (a -> b) -> a -> b
$ (CandidateFile -> Bool) -> [CandidateFile] -> [CandidateFile]
forall a. (a -> Bool) -> [a] -> [a]
filter CandidateFile -> Bool
expMatch [CandidateFile]
allNames
     Bool -> LogicT (StateT IterStat Identity) ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> LogicT (StateT IterStat Identity) ())
-> Bool -> LogicT (StateT IterStat Identity) ()
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 a -> [(a, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup a
p [(a, b)]
r of
                                   Maybe b
Nothing -> (a
p,b
v) (a, b) -> [(a, b)] -> [(a, b)]
forall a. a -> [a] -> [a]
: [(a, b)]
r
                                   Just b
_ -> [(a, b)]
r
     [NamedParamMatch]
rAndeMatches <- [NamedParamMatch]
-> LogicT (StateT IterStat Identity) [NamedParamMatch]
forall a. a -> LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamedParamMatch -> [NamedParamMatch] -> [NamedParamMatch])
-> [NamedParamMatch] -> [NamedParamMatch] -> [NamedParamMatch]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NamedParamMatch -> [NamedParamMatch] -> [NamedParamMatch]
forall {a} {b}. Eq a => (a, b) -> [(a, b)] -> [(a, b)]
onlyOneOfEach [NamedParamMatch]
rmatch (CandidateFile -> [NamedParamMatch]
candidatePMatch CandidateFile
efile))
                     LogicT (StateT IterStat Identity) [NamedParamMatch]
-> LogicT (StateT IterStat Identity) [NamedParamMatch]
-> LogicT (StateT IterStat Identity) [NamedParamMatch]
forall a.
LogicT (StateT IterStat Identity) a
-> LogicT (StateT IterStat Identity) a
-> LogicT (StateT IterStat Identity) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
unconstrained
                           then LogicT (StateT IterStat Identity) [NamedParamMatch]
forall a. LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                          else let unConstr :: (String, b) -> Bool
unConstr = (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
unconstrained) (String -> Bool) -> ((String, b) -> String) -> (String, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, b) -> String
forall a b. (a, b) -> a
fst
                                   rm :: [NamedParamMatch]
rm = (NamedParamMatch -> Bool) -> [NamedParamMatch] -> [NamedParamMatch]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (NamedParamMatch -> Bool) -> NamedParamMatch -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedParamMatch -> Bool
forall {b}. (String, b) -> Bool
unConstr) (CandidateFile -> [NamedParamMatch]
candidatePMatch CandidateFile
efile)
                               in if [NamedParamMatch] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NamedParamMatch]
rm
                                  then LogicT (StateT IterStat Identity) [NamedParamMatch]
forall a. LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
                                  else [NamedParamMatch]
-> LogicT (StateT IterStat Identity) [NamedParamMatch]
forall a. a -> LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((NamedParamMatch -> [NamedParamMatch] -> [NamedParamMatch])
-> [NamedParamMatch] -> [NamedParamMatch] -> [NamedParamMatch]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NamedParamMatch -> [NamedParamMatch] -> [NamedParamMatch]
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] -> LogicI [(String, CandidateFile)])
-> [CandidateFile] -> LogicI [(String, CandidateFile)]
forall a b. (a -> b) -> a -> b
$ (CandidateFile -> Bool) -> [CandidateFile] -> [CandidateFile]
forall a. (a -> Bool) -> [a] -> [a]
filter (CandidateFile
rootN CandidateFile -> CandidateFile -> Bool
forall a. Eq a => a -> a -> Bool
/=) [CandidateFile]
allNames
     Expectation -> LogicI Expectation
forall a. a -> LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expectation -> LogicI Expectation)
-> Expectation -> LogicI Expectation
forall a b. (a -> b) -> a -> b
$ Expectation { expectedFile :: String
expectedFile = CandidateFile -> String
candidateToPath CandidateFile
efile
                          , associated :: [(String, String)]
associated = (CandidateFile -> String)
-> (String, CandidateFile) -> (String, String)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CandidateFile -> String
candidateToPath ((String, CandidateFile) -> (String, String))
-> [(String, CandidateFile)] -> [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, CandidateFile)]
assocFiles
                          , expParamsMatch :: [NamedParamMatch]
expParamsMatch = [NamedParamMatch] -> [NamedParamMatch]
forall a. Ord a => [a] -> [a]
L.sort [NamedParamMatch]
pmatch
                          }



-- | Determines the best Expectations to use from a list of Expectations that may
-- have different parameter match status against an expected file.  When two
-- Expectations differ only in an Explicit v.s. Assumed (or wildcard) the
-- Explicit is preferred.  Expectations with more parameter matches are preferred
-- over those with less.

collateExpectations :: [Expectation] -> [Expectation]
collateExpectations :: [Expectation] -> [Expectation]
collateExpectations [Expectation]
allExps =
  let paramsAndVals :: Expectation -> [(String, Maybe String)]
paramsAndVals = (NamedParamMatch -> (String, Maybe String))
-> [NamedParamMatch] -> [(String, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParamMatch -> Maybe String)
-> NamedParamMatch -> (String, Maybe String)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParamMatch -> Maybe String
getParamVal)
                      ([NamedParamMatch] -> [(String, Maybe String)])
-> (Expectation -> [NamedParamMatch])
-> Expectation
-> [(String, Maybe String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedParamMatch -> NamedParamMatch -> Ordering)
-> [NamedParamMatch] -> [NamedParamMatch]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> String -> Ordering)
-> (NamedParamMatch -> String)
-> NamedParamMatch
-> NamedParamMatch
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` NamedParamMatch -> String
forall a b. (a, b) -> a
fst)
                      ([NamedParamMatch] -> [NamedParamMatch])
-> (Expectation -> [NamedParamMatch])
-> Expectation
-> [NamedParamMatch]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> [NamedParamMatch]
expParamsMatch

      -- The matching named parameters should have matching values; there could
      -- be extra parameters in on or the other, but not both.  Give more weight
      -- to Explicit matches, even those not present in the other match.  This
      -- requires both a and b parameter lists to be sorted on parameter name.
      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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
yn
              then a
xv a -> a -> Bool
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)]
_ = String -> Bool
forall a. HasCallStack => String -> a
error String
"first argument must be longest list for pvMatch"
        in if [(a, a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, a)]
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [(a, a)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, a)]
b then [(a, a)] -> [(a, a)] -> Bool
forall {a} {a}. (Eq a, Eq a) => [(a, a)] -> [(a, a)] -> Bool
pvCmp [(a, a)]
a [(a, a)]
b else [(a, a)] -> [(a, a)] -> Bool
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) [] = Ordering -> Ordering -> Ordering
forall a b. a -> b -> a
const Ordering
GT (Ordering -> Ordering) -> (Int, Ordering) -> (Int, Ordering)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [(a, ParamMatch)] -> [(a, ParamMatch)] -> (Int, Ordering)
pvCmpN (Int
n Int -> Int -> Int
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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
yn
              then case Maybe String -> Maybe String -> Ordering
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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ ParamMatch -> Int
weight ParamMatch
xv Int -> Int -> Int
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 Int -> Int -> Int
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 Int -> [(a, ParamMatch)] -> [(a, ParamMatch)] -> (Int, Ordering)
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
                                     then Ordering
GT
                                     else if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Ordering
LT
                                          else [(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
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 [(a, ParamMatch)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, ParamMatch)]
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [(a, ParamMatch)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(a, ParamMatch)]
b
           then [(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
forall {a}.
Ord a =>
[(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCmp [(a, ParamMatch)]
a [(a, ParamMatch)]
b
           else Ordering -> Ordering
invertCmp (Ordering -> Ordering) -> Ordering -> Ordering
forall a b. (a -> b) -> a -> b
$ [(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
forall {a}.
Ord a =>
[(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCmp [(a, ParamMatch)]
b [(a, ParamMatch)]
a

      -- expGrps are expectations grouped by having the same parameter names and
      -- values (just the value, not the ParamMatch).
      expGrps :: [[Expectation]]
expGrps = (Expectation -> Expectation -> Bool)
-> [Expectation] -> [[Expectation]]
forall {a}. (a -> a -> Bool) -> [a] -> [[a]]
collectBy ([(String, Maybe String)] -> [(String, Maybe String)] -> Bool
forall {a} {a}. (Eq a, Eq a) => [(a, a)] -> [(a, a)] -> Bool
pvMatch ([(String, Maybe String)] -> [(String, Maybe String)] -> Bool)
-> (Expectation -> [(String, Maybe String)])
-> Expectation
-> Expectation
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> [(String, Maybe String)]
paramsAndVals)
                ([Expectation] -> [[Expectation]])
-> [Expectation] -> [[Expectation]]
forall a b. (a -> b) -> a -> b
$ [Expectation] -> [Expectation]
forall a. [a] -> [a]
L.reverse
                ([Expectation] -> [Expectation]) -> [Expectation] -> [Expectation]
forall a b. (a -> b) -> a -> b
$ (Expectation -> Expectation -> Ordering)
-> [Expectation] -> [Expectation]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Expectation -> Int) -> Expectation -> Expectation -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([NamedParamMatch] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([NamedParamMatch] -> Int)
-> (Expectation -> [NamedParamMatch]) -> Expectation -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> [NamedParamMatch]
expParamsMatch))
                ([Expectation] -> [Expectation]) -> [Expectation] -> [Expectation]
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) = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (a -> a -> Bool
f a
e) [a]
es
                           in (a
e a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
s) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: (a -> a -> Bool) -> [a] -> [[a]]
collectBy a -> a -> Bool
f [a]
d
  in
    -- For each group of expectations that have the same values, find the best of
    -- the group by ordering first on ParamMatch, and then resolving ties based
    -- on the length of the expected filename.
    ([Expectation] -> [Expectation])
-> [[Expectation]] -> [Expectation]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int -> [Expectation] -> [Expectation]
forall a. Int -> [a] -> [a]
take Int
1
               -- Resolve ties by taking the longest filename
               ([Expectation] -> [Expectation])
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> [Expectation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expectation] -> [Expectation]
forall a. [a] -> [a]
L.reverse
               ([Expectation] -> [Expectation])
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> [Expectation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expectation -> Expectation -> Ordering)
-> [Expectation] -> [Expectation]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> (Expectation -> Int) -> Expectation -> Expectation -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> (Expectation -> String) -> Expectation -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expectation -> String
expectedFile))
               -- Discard all but the best ParamMatch
              ([Expectation] -> [Expectation])
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> [Expectation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expectation] -> [Expectation]
forall a. [a] -> [a]
L.reverse
               ([Expectation] -> [Expectation])
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> [Expectation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Expectation]] -> [Expectation]
forall a. HasCallStack => [a] -> a
head
               -- Group by equal ParamMatch (may be multiple files)
               ([[Expectation]] -> [Expectation])
-> ([Expectation] -> [[Expectation]])
-> [Expectation]
-> [Expectation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expectation -> Expectation -> Bool)
-> [Expectation] -> [[Expectation]]
forall {a}. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy ([NamedParamMatch] -> [NamedParamMatch] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([NamedParamMatch] -> [NamedParamMatch] -> Bool)
-> (Expectation -> [NamedParamMatch])
-> Expectation
-> Expectation
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> [NamedParamMatch]
expParamsMatch)
               -- Order this group by best ParamsMatch (Explicit) to worst
               ([Expectation] -> [[Expectation]])
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> [[Expectation]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Expectation] -> [Expectation]
forall a. [a] -> [a]
L.reverse
               ([Expectation] -> [Expectation])
-> ([Expectation] -> [Expectation])
-> [Expectation]
-> [Expectation]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expectation -> Expectation -> Ordering)
-> [Expectation] -> [Expectation]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ([NamedParamMatch] -> [NamedParamMatch] -> Ordering
forall {a}.
Ord a =>
[(a, ParamMatch)] -> [(a, ParamMatch)] -> Ordering
pvCompare ([NamedParamMatch] -> [NamedParamMatch] -> Ordering)
-> (Expectation -> [NamedParamMatch])
-> Expectation
-> Expectation
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Expectation -> [NamedParamMatch]
expParamsMatch)
              ) [[Expectation]]
expGrps