{-# LANGUAGE LambdaCase #-}
{-# 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
  , removeNonExplicitMatchingExpectations
  )
  where

import           Control.Monad
import           Control.Monad.Logic
import qualified Data.List as L

import           Test.Tasty.Sugar.AssocCheck
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
                -> CandidateFile   --  original name of source
                -> [CandidateFile] --  all of the names to choose from
                -> ([NamedParamMatch], CandidateFile, String) -- param constraints from the root name
                -> Maybe ( Sweets, SweetExplanation )
findExpectation :: CUBE
-> CandidateFile
-> [CandidateFile]
-> ([NamedParamMatch], CandidateFile, String)
-> Maybe (Sweets, SweetExplanation)
findExpectation CUBE
pat CandidateFile
rootN [CandidateFile]
allNames ([NamedParamMatch]
rootPMatches, CandidateFile
matchPrefix, String
_) =
  let r :: Maybe Sweets
r = [Expectation] -> Maybe Sweets
mkSweet ([Expectation] -> Maybe Sweets) -> [Expectation] -> Maybe Sweets
forall a b. (a -> b) -> a -> b
$
          [Expectation] -> [Expectation]
trimExpectations ([Expectation] -> [Expectation]) -> [Expectation] -> [Expectation]
forall a b. (a -> b) -> a -> b
$
           Logic Expectation -> [Expectation]
forall a. Logic a -> [a]
observeAll (Logic Expectation -> [Expectation])
-> Logic Expectation -> [Expectation]
forall a b. (a -> b) -> a -> b
$
           do Bool -> LogicT 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [CandidateFile]
candidates)
              CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> String
-> [(String, String)]
-> [CandidateFile]
-> Logic 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
      params :: [ParameterPattern]
params = CUBE -> [ParameterPattern]
validParams CUBE
pat
      expSuffix :: String
expSuffix = CUBE -> String
expectedSuffix CUBE
pat
      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 = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ CandidateFile -> String
candidateFile CandidateFile
matchPrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` CandidateFile -> String
candidateFile CandidateFile
f
                       , CandidateFile
rootN CandidateFile -> CandidateFile -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 :: String
-> String
-> String
-> [ParameterPattern]
-> [Expectation]
-> Sweets
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]
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]
removeNonExplicitMatchingExpectations
        -- 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
r of
       Maybe Sweets
Nothing -> Maybe (Sweets, SweetExplanation)
forall a. Maybe a
Nothing
       Just Sweets
r' | [] <- Sweets -> [Expectation]
expected Sweets
r' -> Maybe (Sweets, SweetExplanation)
forall a. Maybe a
Nothing
       Just Sweets
r' -> (Sweets, SweetExplanation) -> Maybe (Sweets, SweetExplanation)
forall a. a -> Maybe a
Just ( Sweets
r'
                       , SweetExpl :: String -> String -> [String] -> Sweets -> SweetExplanation
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
                                       (if String -> 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`))
                                     (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'
                                   })


-- Find all Expectations matching this rootMatch
expectedSearch :: CandidateFile
               -> [NamedParamMatch]
               -> Separators
               -> [ParameterPattern]
               -> FileSuffix
               -> [ (String, FileSuffix) ]
               -> [CandidateFile]
               -> Logic Expectation
expectedSearch :: CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> String
-> [(String, String)]
-> [CandidateFile]
-> Logic Expectation
expectedSearch CandidateFile
rootPrefix [NamedParamMatch]
rootPVMatches String
seps [ParameterPattern]
params String
expSuffix [(String, String)]
assocNames [CandidateFile]
allNames =
  do [ParameterPattern]
params' <- [NamedParamMatch] -> [ParameterPattern] -> Logic [ParameterPattern]
singlePVals [NamedParamMatch]
rootPVMatches [ParameterPattern]
params
     (CandidateFile
expFile, [NamedParamMatch]
pmatch, [(String, CandidateFile)]
assocFiles) <-
       let bestRanked :: (Eq a, Eq b, Eq c)
                      => [((a, Int, [b]),c)] -> Logic (a, [b], c)
           bestRanked :: [((a, Int, [b]), c)] -> Logic (a, [b], c)
bestRanked [((a, Int, [b]), c)]
l =
             if [((a, Int, [b]), c)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [((a, Int, [b]), c)]
l then Logic (a, [b], c)
forall (m :: * -> *) a. MonadPlus m => m a
mzero
             else let m :: Int
m = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (((a, Int, [b]), c) -> Int) -> [((a, Int, [b]), c)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, Int, [b]), c) -> Int
forall a b c b. ((a, b, c), b) -> b
rankValue [((a, Int, [b]), c)]
l
                      rankValue :: ((a, b, c), b) -> b
rankValue ((a
_,b
r,c
_),b
_) = b
r
                      rankMatching :: a -> ((a, a, c), b) -> Bool
rankMatching a
v ((a
_,a
r,c
_),b
_) = a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
r
                      dropRank :: ((a, b, b), c) -> (a, b, c)
dropRank ((a
a,b
_,b
b),c
c) = (a
a,b
b,c
c)
                  in [(a, [b], c)] -> Logic (a, [b], c)
forall a. [a] -> Logic a
eachFrom ([(a, [b], c)] -> Logic (a, [b], c))
-> [(a, [b], c)] -> Logic (a, [b], c)
forall a b. (a -> b) -> a -> b
$ [(a, [b], c)] -> [(a, [b], c)]
forall a. Eq a => [a] -> [a]
L.nub ([(a, [b], c)] -> [(a, [b], c)]) -> [(a, [b], c)] -> [(a, [b], c)]
forall a b. (a -> b) -> a -> b
$ (((a, Int, [b]), c) -> (a, [b], c))
-> [((a, Int, [b]), c)] -> [(a, [b], c)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a, Int, [b]), c) -> (a, [b], c)
forall a b b c. ((a, b, b), c) -> (a, b, c)
dropRank ([((a, Int, [b]), c)] -> [(a, [b], c)])
-> [((a, Int, [b]), c)] -> [(a, [b], c)]
forall a b. (a -> b) -> a -> b
$ (((a, Int, [b]), c) -> Bool)
-> [((a, Int, [b]), c)] -> [((a, Int, [b]), c)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Int -> ((a, Int, [b]), c) -> Bool
forall a a c b. Eq a => a -> ((a, a, c), b) -> Bool
rankMatching Int
m) [((a, Int, [b]), c)]
l

       in [((CandidateFile, Int, [NamedParamMatch]),
  [(String, CandidateFile)])]
-> Logic
     (CandidateFile, [NamedParamMatch], [(String, CandidateFile)])
forall a b c.
(Eq a, Eq b, Eq c) =>
[((a, Int, [b]), c)] -> Logic (a, [b], c)
bestRanked ([((CandidateFile, Int, [NamedParamMatch]),
   [(String, CandidateFile)])]
 -> Logic
      (CandidateFile, [NamedParamMatch], [(String, CandidateFile)]))
-> [((CandidateFile, Int, [NamedParamMatch]),
     [(String, CandidateFile)])]
-> Logic
     (CandidateFile, [NamedParamMatch], [(String, CandidateFile)])
forall a b. (a -> b) -> a -> b
$
          Logic
  ((CandidateFile, Int, [NamedParamMatch]),
   [(String, CandidateFile)])
-> [((CandidateFile, Int, [NamedParamMatch]),
     [(String, CandidateFile)])]
forall a. Logic a -> [a]
observeAll (Logic
   ((CandidateFile, Int, [NamedParamMatch]),
    [(String, CandidateFile)])
 -> [((CandidateFile, Int, [NamedParamMatch]),
      [(String, CandidateFile)])])
-> Logic
     ((CandidateFile, Int, [NamedParamMatch]),
      [(String, CandidateFile)])
-> [((CandidateFile, Int, [NamedParamMatch]),
     [(String, CandidateFile)])]
forall a b. (a -> b) -> a -> b
$
          do [ParameterPattern]
pseq <- [[ParameterPattern]] -> Logic [ParameterPattern]
forall a. [a] -> Logic a
eachFrom ([[ParameterPattern]] -> Logic [ParameterPattern])
-> [[ParameterPattern]] -> Logic [ParameterPattern]
forall a b. (a -> b) -> a -> b
$
                     ([] [ParameterPattern] -> [[ParameterPattern]] -> [[ParameterPattern]]
forall a. a -> [a] -> [a]
:) ([[ParameterPattern]] -> [[ParameterPattern]])
-> [[ParameterPattern]] -> [[ParameterPattern]]
forall a b. (a -> b) -> a -> b
$
                     ([ParameterPattern] -> Bool)
-> [[ParameterPattern]] -> [[ParameterPattern]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([ParameterPattern] -> Bool) -> [ParameterPattern] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ParameterPattern] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([[ParameterPattern]] -> [[ParameterPattern]])
-> [[ParameterPattern]] -> [[ParameterPattern]]
forall a b. (a -> b) -> a -> b
$
                     ([ParameterPattern] -> [[ParameterPattern]])
-> [[ParameterPattern]] -> [[ParameterPattern]]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [ParameterPattern] -> [[ParameterPattern]]
forall a. [a] -> [[a]]
L.inits ([[ParameterPattern]] -> [[ParameterPattern]])
-> [[ParameterPattern]] -> [[ParameterPattern]]
forall a b. (a -> b) -> a -> b
$
                     [ParameterPattern] -> [[ParameterPattern]]
forall a. [a] -> [[a]]
L.permutations [ParameterPattern]
params'
             [(String, Maybe String)]
pvals <- [ParameterPattern] -> Logic [(String, Maybe String)]
getPVals [ParameterPattern]
pseq
             let compatNames :: [CandidateFile]
compatNames = (CandidateFile -> Bool) -> [CandidateFile] -> [CandidateFile]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
-> [ParameterPattern]
-> [(String, Maybe String)]
-> CandidateFile
-> Bool
isCompatible String
seps [ParameterPattern]
params [(String, Maybe String)]
pvals) [CandidateFile]
allNames
             Bool -> LogicT 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [CandidateFile]
compatNames)
             e :: (CandidateFile, Int, [NamedParamMatch])
e@(CandidateFile
_,Int
_,[NamedParamMatch]
pmatch) <- CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> [(String, Maybe String)]
-> String
-> [CandidateFile]
-> Logic (CandidateFile, Int, [NamedParamMatch])
getExp CandidateFile
rootPrefix [NamedParamMatch]
rootPVMatches String
seps [ParameterPattern]
params [(String, Maybe String)]
pvals
                               String
expSuffix [CandidateFile]
compatNames
             [(String, CandidateFile)]
a <- (CandidateFile
-> String
-> [NamedParamMatch]
-> [(String, String)]
-> [CandidateFile]
-> Logic [(String, CandidateFile)]
getAssoc CandidateFile
rootPrefix String
seps [NamedParamMatch]
pmatch [(String, String)]
assocNames [CandidateFile]
compatNames)
             ((CandidateFile, Int, [NamedParamMatch]),
 [(String, CandidateFile)])
-> Logic
     ((CandidateFile, Int, [NamedParamMatch]),
      [(String, CandidateFile)])
forall (m :: * -> *) a. Monad m => a -> m a
return ((CandidateFile, Int, [NamedParamMatch])
e,[(String, CandidateFile)]
a)
     Expectation -> Logic Expectation
forall (m :: * -> *) a. Monad m => a -> m a
return (Expectation -> Logic Expectation)
-> Expectation -> Logic Expectation
forall a b. (a -> b) -> a -> b
$ Expectation :: String -> [NamedParamMatch] -> [(String, String)] -> Expectation
Expectation { expectedFile :: String
expectedFile = CandidateFile -> String
candidateToPath CandidateFile
expFile
                          , associated :: [(String, String)]
associated = (CandidateFile -> String)
-> (String, CandidateFile) -> (String, String)
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
                          }


-- | Get all expected files for a particular sequence of param+value.
-- Returns the expected file, the sequence of parameter values that
-- match that expect file, and a ranking (the number of those paramter
-- values that actually appear in the expect file.
getExp :: CandidateFile
       -> [NamedParamMatch]
       -> Separators
       -> [ParameterPattern]
       -> [(String, Maybe String)]
       -> FileSuffix
       -> [CandidateFile]
       -> Logic (CandidateFile, Int, [NamedParamMatch])
getExp :: CandidateFile
-> [NamedParamMatch]
-> String
-> [ParameterPattern]
-> [(String, Maybe String)]
-> String
-> [CandidateFile]
-> Logic (CandidateFile, Int, [NamedParamMatch])
getExp CandidateFile
rootPrefix [NamedParamMatch]
rootPMatches String
seps [ParameterPattern]
params [(String, Maybe String)]
pvals String
expSuffix [CandidateFile]
allNames =
  do -- Some of the params may be encoded in the subdirectories instead of in the
     -- target filename (each param value could appear in either).  If a
     -- rootPMatches value is in a subdirectory, no other values for that
     -- parameter can appear, otherwise all possible values could appear.  A
     -- subset of the rootPMatches may appear in the subdirs, but only the
     -- maximal subset can be considered.

     let rootMatchesInSubdir :: CandidateFile -> [NamedParamMatch]
         rootMatchesInSubdir :: CandidateFile -> [NamedParamMatch]
rootMatchesInSubdir CandidateFile
f =
           let chkRootMatch :: String -> [NamedParamMatch] -> [NamedParamMatch]
chkRootMatch String
d [NamedParamMatch]
r =
                 let chkRPMatch :: (a, ParamMatch) -> [(a, ParamMatch)] -> [(a, ParamMatch)]
chkRPMatch (a, ParamMatch)
p [(a, ParamMatch)]
r' =
                       case ParamMatch -> Maybe String
getExplicit (ParamMatch -> Maybe String) -> ParamMatch -> Maybe String
forall a b. (a -> b) -> a -> b
$ (a, ParamMatch) -> ParamMatch
forall a b. (a, b) -> b
snd (a, ParamMatch)
p of
                         Just String
v -> if String
d String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
v then (a, ParamMatch)
p (a, ParamMatch) -> [(a, ParamMatch)] -> [(a, ParamMatch)]
forall a. a -> [a] -> [a]
: [(a, ParamMatch)]
r' else [(a, ParamMatch)]
r'
                         Maybe String
Nothing -> [(a, ParamMatch)]
r'
                 in (NamedParamMatch -> [NamedParamMatch] -> [NamedParamMatch])
-> [NamedParamMatch] -> [NamedParamMatch] -> [NamedParamMatch]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NamedParamMatch -> [NamedParamMatch] -> [NamedParamMatch]
forall a. (a, ParamMatch) -> [(a, ParamMatch)] -> [(a, ParamMatch)]
chkRPMatch [NamedParamMatch]
r [NamedParamMatch]
rootPMatches
           in (String -> [NamedParamMatch] -> [NamedParamMatch])
-> [NamedParamMatch] -> [String] -> [NamedParamMatch]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> [NamedParamMatch] -> [NamedParamMatch]
chkRootMatch [NamedParamMatch]
forall a. Monoid a => a
mempty ([String] -> [NamedParamMatch]) -> [String] -> [NamedParamMatch]
forall a b. (a -> b) -> a -> b
$ CandidateFile -> [String]
candidateSubdirs CandidateFile
f

     let inpDirMatches :: [(CandidateFile, [NamedParamMatch])]
inpDirMatches = (CandidateFile -> [NamedParamMatch])
-> (CandidateFile, CandidateFile)
-> (CandidateFile, [NamedParamMatch])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CandidateFile -> [NamedParamMatch]
rootMatchesInSubdir ((CandidateFile, CandidateFile)
 -> (CandidateFile, [NamedParamMatch]))
-> [(CandidateFile, CandidateFile)]
-> [(CandidateFile, [NamedParamMatch])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CandidateFile]
-> [CandidateFile] -> [(CandidateFile, CandidateFile)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CandidateFile]
allNames [CandidateFile]
allNames

     (CandidateFile
dirName, [NamedParamMatch]
inpDirMatch) <- [(CandidateFile, [NamedParamMatch])]
-> Logic (CandidateFile, [NamedParamMatch])
forall a. [a] -> Logic a
eachFrom [(CandidateFile, [NamedParamMatch])]
inpDirMatches

     let nonRootMatchPVals :: [(String, Maybe String)]
nonRootMatchPVals = [(String, Maybe String)]
-> [NamedParamMatch] -> [(String, Maybe String)]
forall a b. [(String, a)] -> [(String, b)] -> [(String, a)]
removePVals [(String, Maybe String)]
pvals [NamedParamMatch]
inpDirMatch

     ([NamedParamMatch]
otherMatchesInSubdir, [ParameterPattern]
_) <-
           CandidateFile
-> [ParameterPattern]
-> [ParameterPattern]
-> Logic ([NamedParamMatch], [ParameterPattern])
dirMatches CandidateFile
dirName [ParameterPattern]
params ([ParameterPattern]
 -> Logic ([NamedParamMatch], [ParameterPattern]))
-> [ParameterPattern]
-> Logic ([NamedParamMatch], [ParameterPattern])
forall a b. (a -> b) -> a -> b
$ ((Maybe String -> Maybe [String])
-> (String, Maybe String) -> ParameterPattern
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> [String]) -> Maybe String -> Maybe [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[])) ((String, Maybe String) -> ParameterPattern)
-> [(String, Maybe String)] -> [ParameterPattern]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, Maybe String)]
nonRootMatchPVals)

     let remPVals :: [(String, Maybe String)]
remPVals = [(String, Maybe String)]
-> [NamedParamMatch] -> [(String, Maybe String)]
forall a b. [(String, a)] -> [(String, b)] -> [(String, a)]
removePVals [(String, Maybe String)]
nonRootMatchPVals [NamedParamMatch]
otherMatchesInSubdir

     let remRootMatches :: [NamedParamMatch]
remRootMatches = [NamedParamMatch] -> [NamedParamMatch] -> [NamedParamMatch]
forall a b. [(String, a)] -> [(String, b)] -> [(String, a)]
removePVals [NamedParamMatch]
rootPMatches [NamedParamMatch]
inpDirMatch
     let validNames :: [CandidateFile]
validNames = [ CandidateFile
dirName ]

     (CandidateFile
fp, Int
cnt, [NamedParamMatch]
npm) <- CandidateFile
-> [NamedParamMatch]
-> String
-> [(String, Maybe String)]
-> String
-> [CandidateFile]
-> Logic (CandidateFile, Int, [NamedParamMatch])
getExpFileParams CandidateFile
rootPrefix
                       [NamedParamMatch]
remRootMatches
                       String
seps [(String, Maybe String)]
remPVals String
expSuffix [CandidateFile]
validNames


     -- Corner case: a wildcard parameter could be selected from both a subdir
     -- and the filename... if the values are the same, that's OK, but if the
     -- values are different it should be rejected.

     let dpm :: [NamedParamMatch]
dpm = [NamedParamMatch]
inpDirMatch [NamedParamMatch] -> [NamedParamMatch] -> [NamedParamMatch]
forall a. Semigroup a => a -> a -> a
<> [NamedParamMatch]
otherMatchesInSubdir

     let conflict :: Bool
conflict = let chkNPM :: NamedParamMatch -> Bool -> Bool
chkNPM (String
pn,ParamMatch
pv) Bool
acc =
                          Bool
acc Bool -> Bool -> Bool
|| case String -> [NamedParamMatch] -> Maybe ParamMatch
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn [NamedParamMatch]
dpm of
                                   Maybe ParamMatch
Nothing -> Bool
False
                                   Just ParamMatch
v -> ParamMatch
v ParamMatch -> ParamMatch -> Bool
forall a. Eq a => a -> a -> Bool
/= ParamMatch
pv
                    in (NamedParamMatch -> Bool -> Bool)
-> Bool -> [NamedParamMatch] -> Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NamedParamMatch -> Bool -> Bool
chkNPM Bool
False [NamedParamMatch]
npm
     Bool -> LogicT Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
conflict)

     (CandidateFile, Int, [NamedParamMatch])
-> Logic (CandidateFile, Int, [NamedParamMatch])
forall (m :: * -> *) a. Monad m => a -> m a
return (CandidateFile
fp, [NamedParamMatch] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NamedParamMatch]
dpm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cnt, [NamedParamMatch]
dpm [NamedParamMatch] -> [NamedParamMatch] -> [NamedParamMatch]
forall a. Semigroup a => a -> a -> a
<> [NamedParamMatch]
npm)


getExpFileParams :: CandidateFile
                 -> [NamedParamMatch]
                 -> Separators
                 -> [(String, Maybe String)]
                 -> FileSuffix
                 -> [CandidateFile]
                 -> Logic (CandidateFile, Int, [NamedParamMatch])
getExpFileParams :: CandidateFile
-> [NamedParamMatch]
-> String
-> [(String, Maybe String)]
-> String
-> [CandidateFile]
-> Logic (CandidateFile, Int, [NamedParamMatch])
getExpFileParams CandidateFile
rootPrefix [NamedParamMatch]
rootPMatches String
seps [(String, Maybe String)]
pvals String
expSuffix [CandidateFile]
hereNames =
  do let suffixSpecifiesSep :: Bool
suffixSpecifiesSep = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
expSuffix)
                                  , String -> Char
forall a. [a] -> a
head String
expSuffix Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
seps
                                  ]
     ([NamedParamMatch]
pm, Int
pmcnt, String
pmstr) <- String
-> [NamedParamMatch]
-> [(String, Maybe String)]
-> Logic ([NamedParamMatch], Int, String)
pvalMatch String
seps [NamedParamMatch]
rootPMatches [(String, Maybe String)]
pvals

     -- If the expSuffix starts with a separator then *only that*
     -- separator is allowed for the suffix (other seps are still
     -- allowed for parameter value separation).
     let suffixSepMatch :: Bool
suffixSepMatch = Bool -> Bool
not Bool
suffixSpecifiesSep
                          Bool -> Bool -> Bool
|| [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
pmstr)
                                 , String -> Char
forall a. [a] -> a
last String
pmstr Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Char
forall a. [a] -> a
head String
expSuffix
                                 ]
     Bool -> LogicT Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
suffixSepMatch

     let ending :: String
ending = if Bool
suffixSpecifiesSep then String -> String
forall a. [a] -> [a]
tail String
expSuffix else String
expSuffix

     CandidateFile
expFile <-
       [CandidateFile] -> Logic CandidateFile
forall a. [a] -> Logic a
eachFrom
       ([CandidateFile] -> Logic CandidateFile)
-> [CandidateFile] -> Logic CandidateFile
forall a b. (a -> b) -> a -> b
$ (CandidateFile -> Bool) -> [CandidateFile] -> [CandidateFile]
forall a. (a -> Bool) -> [a] -> [a]
filter (((CandidateFile -> String
candidateFile CandidateFile
rootPrefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pmstr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
ending) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==) (String -> Bool)
-> (CandidateFile -> String) -> CandidateFile -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CandidateFile -> String
candidateFile)
       ([CandidateFile] -> [CandidateFile])
-> [CandidateFile] -> [CandidateFile]
forall a b. (a -> b) -> a -> b
$ [CandidateFile]
hereNames

     (CandidateFile, Int, [NamedParamMatch])
-> Logic (CandidateFile, Int, [NamedParamMatch])
forall (m :: * -> *) a. Monad m => a -> m a
return (CandidateFile
expFile, Int
pmcnt, [NamedParamMatch]
pm)


-- | 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.

removeNonExplicitMatchingExpectations :: [Expectation] -> [Expectation]
removeNonExplicitMatchingExpectations :: [Expectation] -> [Expectation]
removeNonExplicitMatchingExpectations =
  let removeNonExplicits :: Expectation -> [Expectation] -> [Expectation]
removeNonExplicits Expectation
e [Expectation]
l =
        let ([Expectation]
similarExpl, [Expectation]
diffExpl) = (Expectation -> Bool)
-> [Expectation] -> ([Expectation], [Expectation])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Expectation -> Expectation -> Bool
cmpPVals Expectation
e) [Expectation]
l
            cmpPVals :: Expectation -> Expectation -> Bool
cmpPVals Expectation
ref Expectation
ps =
              -- Compare the two on the intersection subset of parameters
              if [NamedParamMatch] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Expectation -> [NamedParamMatch]
expParamsMatch Expectation
ref) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [NamedParamMatch] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Expectation -> [NamedParamMatch]
expParamsMatch Expectation
ps)
              then Expectation -> Expectation -> [Maybe String]
expPVals Expectation
ref Expectation
ref [Maybe String] -> [Maybe String] -> Bool
forall a. Eq a => a -> a -> Bool
== Expectation -> Expectation -> [Maybe String]
expPVals Expectation
ref Expectation
ps
              else Expectation -> Expectation -> [Maybe String]
expPVals Expectation
ps Expectation
ps [Maybe String] -> [Maybe String] -> Bool
forall a. Eq a => a -> a -> Bool
== Expectation -> Expectation -> [Maybe String]
expPVals Expectation
ps Expectation
ref
            expPVals :: Expectation -> Expectation -> [Maybe String]
expPVals Expectation
ref Expectation
ps =
              -- Compare parameters by comparing the values of matching names
              let ps' :: [NamedParamMatch]
ps' = Expectation -> [NamedParamMatch]
expParamsMatch Expectation
ps
                  ref' :: [NamedParamMatch]
ref' = Expectation -> [NamedParamMatch]
expParamsMatch Expectation
ref
                  refNames :: [String]
refNames = NamedParamMatch -> String
forall a b. (a, b) -> a
fst (NamedParamMatch -> String) -> [NamedParamMatch] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedParamMatch]
ref'
              in (\String
n -> String -> [NamedParamMatch] -> Maybe ParamMatch
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
n [NamedParamMatch]
ps' Maybe ParamMatch -> (ParamMatch -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParamMatch -> Maybe String
getParamVal) (String -> Maybe String) -> [String] -> [Maybe String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
refNames
        in if [Expectation] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Expectation]
similarExpl
           then Expectation
e Expectation -> [Expectation] -> [Expectation]
forall a. a -> [a] -> [a]
: [Expectation]
l
           else ((Expectation -> [NamedParamMatch])
-> Expectation -> Expectation -> Expectation
forall a. (a -> [NamedParamMatch]) -> a -> a -> a
pmatchMax Expectation -> [NamedParamMatch]
expParamsMatch Expectation
e (Expectation -> Expectation) -> [Expectation] -> [Expectation]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Expectation]
similarExpl) [Expectation] -> [Expectation] -> [Expectation]
forall a. Semigroup a => a -> a -> a
<> [Expectation]
diffExpl
  in (Expectation -> [Expectation] -> [Expectation])
-> [Expectation] -> [Expectation] -> [Expectation]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Expectation -> [Expectation] -> [Expectation]
removeNonExplicits [Expectation]
forall a. Monoid a => a
mempty