{-# OPTIONS_GHC -fno-warn-deprecations #-}

-- | Main internal entry point for determining the various test
-- configurations specified by a CUBE input.

module Test.Tasty.Sugar.Analysis
  (
    checkRoots
  )
where

import           Control.Parallel.Strategies
import           Data.Bifunctor ( bimap )
import           Data.Function ( on )
import qualified Data.List as L
import           Data.Maybe ( catMaybes )
import           Data.Ord ( comparing )
import qualified System.FilePath.GlobPattern as FPGP

import           Test.Tasty.Sugar.ExpectCheck
import           Test.Tasty.Sugar.Iterations
import           Test.Tasty.Sugar.ParamCheck ( pmatchCmp )
import           Test.Tasty.Sugar.Types

import           Prelude hiding ( exp )


-- | Given a 'CUBE' and a list of candidate files in the target directories,
-- return all 'Sweets' matches along with an explanation of the search process.
-- This is the core implementation for the 'Test.Tasty.Sugar.findSugar' API
-- interface.
checkRoots :: CUBE -> [CandidateFile]
           -> (Int, [([Sweets], [SweetExplanation])], IterStat)
checkRoots :: CUBE
-> [CandidateFile]
-> (Int, [([Sweets], [SweetExplanation])], IterStat)
checkRoots CUBE
pat [CandidateFile]
allFiles =
  let isRootMatch :: CandidateFile -> Bool
isRootMatch CandidateFile
n = CandidateFile -> FilePath
candidateFile CandidateFile
n FilePath -> FilePath -> Bool
FPGP.~~ (CUBE -> FilePath
rootName CUBE
pat)
      -- roots is all *possible* roots, but some of these are not roots at all,
      -- and some of these may be the other files associated with a root, so
      -- "root" files cannot be eliminated from the search space yet.
      roots :: [CandidateFile]
roots = (CandidateFile -> Bool) -> [CandidateFile] -> [CandidateFile]
forall a. (a -> Bool) -> [a] -> [a]
L.filter CandidateFile -> Bool
isRootMatch [CandidateFile]
allFiles
      allSweets :: [(([Sweets], [SweetExplanation]), IterStat)]
allSweets = (CUBE
-> [CandidateFile]
-> CandidateFile
-> (([Sweets], [SweetExplanation]), IterStat)
checkRoot CUBE
pat [CandidateFile]
allFiles) (CandidateFile -> (([Sweets], [SweetExplanation]), IterStat))
-> [CandidateFile] -> [(([Sweets], [SweetExplanation]), IterStat)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [CandidateFile]
roots
      checked :: [([Sweets], [SweetExplanation])]
checked = (([Sweets], [SweetExplanation]) -> Bool)
-> [([Sweets], [SweetExplanation])]
-> [([Sweets], [SweetExplanation])]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> (([Sweets], [SweetExplanation]) -> Bool)
-> ([Sweets], [SweetExplanation])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Sweets] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Sweets] -> Bool)
-> (([Sweets], [SweetExplanation]) -> [Sweets])
-> ([Sweets], [SweetExplanation])
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Sweets], [SweetExplanation]) -> [Sweets]
forall a b. (a, b) -> a
fst) ((([Sweets], [SweetExplanation]), IterStat)
-> ([Sweets], [SweetExplanation])
forall a b. (a, b) -> a
fst ((([Sweets], [SweetExplanation]), IterStat)
 -> ([Sweets], [SweetExplanation]))
-> [(([Sweets], [SweetExplanation]), IterStat)]
-> [([Sweets], [SweetExplanation])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(([Sweets], [SweetExplanation]), IterStat)]
allSweets)
      allStats :: IterStat
allStats = (IterStat -> IterStat -> IterStat)
-> IterStat -> [IterStat] -> IterStat
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IterStat -> IterStat -> IterStat
joinStats IterStat
emptyStats ((([Sweets], [SweetExplanation]), IterStat) -> IterStat
forall a b. (a, b) -> b
snd ((([Sweets], [SweetExplanation]), IterStat) -> IterStat)
-> [(([Sweets], [SweetExplanation]), IterStat)] -> [IterStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(([Sweets], [SweetExplanation]), IterStat)]
allSweets)
  in ([([Sweets], [SweetExplanation])] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Sweets], [SweetExplanation])]
checked, [([Sweets], [SweetExplanation])]
checked, IterStat
allStats)


-- checkRoot will attempt to split the identified root file into three
-- parts:
--
--     basename + [param-values] + [suffix/extension]
--
-- Once it has performed this split, the calls findExpectation to
-- check if there are any expected file that matches the basename,
-- expSuffix, and any param-values provided.  A 'Sweets' will be
-- returned for each expected file matching this root configuration
checkRoot :: CUBE
          -> [CandidateFile] --  all possible expect candidates
          -> CandidateFile  --  root path
          -> (([Sweets], [SweetExplanation]), IterStat)
checkRoot :: CUBE
-> [CandidateFile]
-> CandidateFile
-> (([Sweets], [SweetExplanation]), IterStat)
checkRoot CUBE
pat [CandidateFile]
allFiles CandidateFile
rootF =
  let params :: [ParameterPattern]
params = [ParameterPattern] -> [ParameterPattern]
forall a. Ord a => [a] -> [a]
L.sort ([ParameterPattern] -> [ParameterPattern])
-> [ParameterPattern] -> [ParameterPattern]
forall a b. (a -> b) -> a -> b
$ CUBE -> [ParameterPattern]
validParams CUBE
pat
      combineExpRes :: (a, a) -> p [a] [a] -> p [a] [a]
combineExpRes (a
swts, a
expl) = ([a] -> [a]) -> ([a] -> [a]) -> p [a] [a] -> p [a] [a]
forall a b c d. (a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (a
swts a -> [a] -> [a]
forall a. a -> [a] -> [a]
:) (a
expl a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)

      roots :: [([NamedParamMatch], CandidateFile)]
roots = [ ( CandidateFile -> [NamedParamMatch]
candidatePMatch CandidateFile
rootF
                , CandidateFile
rootF { candidateFile =
                          -- truncate the candidateFile to the first separator
                          -- point preceeding parameter matches.
                          let i = Natural -> Int
forall a. Enum a => a -> Int
fromEnum (Natural -> Int) -> Natural -> Int
forall a b. (a -> b) -> a -> b
$ CandidateFile -> Natural
candidateMatchIdx CandidateFile
rootF
                              l = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FilePath -> Int) -> FilePath -> Int
forall a b. (a -> b) -> a -> b
$ CandidateFile -> FilePath
candidateFile CandidateFile
rootF
                              e = Int
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& FilePath -> Char
forall a. HasCallStack => [a] -> a
last (CandidateFile -> FilePath
candidateFile CandidateFile
rootF) Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (CUBE -> FilePath
separators CUBE
pat)
                              t = if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
l Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
e then Int
i else Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                          in take t (candidateFile rootF) }
                )
              , (CandidateFile -> [NamedParamMatch]
candidatePMatch CandidateFile
rootF, CandidateFile
rootF)
              ]

      expAndStats :: [(Maybe (Sweets, SweetExplanation), IterStat)]
expAndStats = Strategy (Maybe (Sweets, SweetExplanation), IterStat)
-> (([NamedParamMatch], CandidateFile)
    -> (Maybe (Sweets, SweetExplanation), IterStat))
-> [([NamedParamMatch], CandidateFile)]
-> [(Maybe (Sweets, SweetExplanation), IterStat)]
forall b a. Strategy b -> (a -> b) -> [a] -> [b]
parMap Strategy (Maybe (Sweets, SweetExplanation), IterStat)
forall a. Strategy a
rpar (CUBE
-> [ParameterPattern]
-> CandidateFile
-> [CandidateFile]
-> ([NamedParamMatch], CandidateFile)
-> (Maybe (Sweets, SweetExplanation), IterStat)
findExpectation CUBE
pat [ParameterPattern]
params CandidateFile
rootF [CandidateFile]
allFiles) [([NamedParamMatch], CandidateFile)]
roots

      sumStats :: IterStat
sumStats = (IterStat -> IterStat -> IterStat)
-> IterStat -> [IterStat] -> IterStat
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IterStat -> IterStat -> IterStat
joinStats IterStat
emptyStats ((Maybe (Sweets, SweetExplanation), IterStat) -> IterStat
forall a b. (a, b) -> b
snd ((Maybe (Sweets, SweetExplanation), IterStat) -> IterStat)
-> [(Maybe (Sweets, SweetExplanation), IterStat)] -> [IterStat]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe (Sweets, SweetExplanation), IterStat)]
expAndStats)
      exps :: ([Sweets], [SweetExplanation])
exps = ((Sweets, SweetExplanation)
 -> ([Sweets], [SweetExplanation])
 -> ([Sweets], [SweetExplanation]))
-> ([Sweets], [SweetExplanation])
-> [(Sweets, SweetExplanation)]
-> ([Sweets], [SweetExplanation])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Sweets, SweetExplanation)
-> ([Sweets], [SweetExplanation]) -> ([Sweets], [SweetExplanation])
forall {p :: * -> * -> *} {a} {a}.
Bifunctor p =>
(a, a) -> p [a] [a] -> p [a] [a]
combineExpRes ([Sweets]
forall a. Monoid a => a
mempty, [SweetExplanation]
forall a. Monoid a => a
mempty) ([(Sweets, SweetExplanation)] -> ([Sweets], [SweetExplanation]))
-> [(Sweets, SweetExplanation)] -> ([Sweets], [SweetExplanation])
forall a b. (a -> b) -> a -> b
$ [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)]
forall (t :: * -> *).
Foldable t =>
t (Sweets, SweetExplanation) -> [(Sweets, SweetExplanation)]
mergeSweets
             ([(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)])
-> [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)]
forall a b. (a -> b) -> a -> b
$ [Maybe (Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)]
forall a. [Maybe a] -> [a]
catMaybes ((Maybe (Sweets, SweetExplanation), IterStat)
-> Maybe (Sweets, SweetExplanation)
forall a b. (a, b) -> a
fst ((Maybe (Sweets, SweetExplanation), IterStat)
 -> Maybe (Sweets, SweetExplanation))
-> [(Maybe (Sweets, SweetExplanation), IterStat)]
-> [Maybe (Sweets, SweetExplanation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Maybe (Sweets, SweetExplanation), IterStat)]
expAndStats)

  in (([Sweets], [SweetExplanation])
exps, IterStat
sumStats)


mergeSweets :: Foldable t
            => t (Sweets, SweetExplanation) -> [(Sweets, SweetExplanation)]
mergeSweets :: forall (t :: * -> *).
Foldable t =>
t (Sweets, SweetExplanation) -> [(Sweets, SweetExplanation)]
mergeSweets t (Sweets, SweetExplanation)
swl =
        -- If multiple Sweets have the same rootMatchName this likely means that
        -- there were multiple expected files that could have matched.  Merge the
        -- Expectations: for each of the second Sweet's expectations:
        --
        --   - If one has a longer rootBaseName, that one represents the more
        --     explicit match and should be used.  Otherwise,
        --
        --   - If no explicit (expParamsMatch) elements match the first, this
        --     is a unique Expectation, add it to the first Sweet
        --
        --   - Find the Expectation in the first Sweet with the most number of
        --     Explicit matches, then select the one that has the most number of
        --     remaining Explicit that don't match the other (one should be a
        --     strict subset of the other!)
        let combineIfRootsMatch :: (Sweets, SweetExplanation)
-> [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)]
combineIfRootsMatch (Sweets, SweetExplanation)
s [(Sweets, SweetExplanation)]
sl =
              -- Add s to sl, or if s matches a root in sl, merge s with that sl
              ([(Sweets, SweetExplanation)]
 -> (Sweets, SweetExplanation) -> [(Sweets, SweetExplanation)])
-> ([(Sweets, SweetExplanation)], (Sweets, SweetExplanation))
-> [(Sweets, SweetExplanation)]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (((Sweets, SweetExplanation)
 -> [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)])
-> [(Sweets, SweetExplanation)]
-> (Sweets, SweetExplanation)
-> [(Sweets, SweetExplanation)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:))
              ( (Sweets, SweetExplanation)
-> [(Sweets, SweetExplanation)] -> (Sweets, SweetExplanation)
forall {t :: * -> *}.
Foldable t =>
(Sweets, SweetExplanation)
-> t (Sweets, SweetExplanation) -> (Sweets, SweetExplanation)
combineSweets (Sweets, SweetExplanation)
s ([(Sweets, SweetExplanation)] -> (Sweets, SweetExplanation))
-> ([(Sweets, SweetExplanation)], [(Sweets, SweetExplanation)])
-> ([(Sweets, SweetExplanation)], (Sweets, SweetExplanation))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Sweets, SweetExplanation) -> Bool)
-> [(Sweets, SweetExplanation)]
-> ([(Sweets, SweetExplanation)], [(Sweets, SweetExplanation)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Bool -> Bool
not (Bool -> Bool)
-> ((Sweets, SweetExplanation) -> Bool)
-> (Sweets, SweetExplanation)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sweets, SweetExplanation) -> (Sweets, SweetExplanation) -> Bool
forall {b}. (Sweets, b) -> (Sweets, b) -> Bool
isRootMatch (Sweets, SweetExplanation)
s) [(Sweets, SweetExplanation)]
sl)
            isRootMatch :: (Sweets, b) -> (Sweets, b) -> Bool
isRootMatch = FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FilePath -> FilePath -> Bool)
-> ((Sweets, b) -> FilePath) -> (Sweets, b) -> (Sweets, b) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Sweets -> FilePath
rootMatchName (Sweets -> FilePath)
-> ((Sweets, b) -> Sweets) -> (Sweets, b) -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Sweets, b) -> Sweets
forall a b. (a, b) -> a
fst)
            combineSweets :: (Sweets, SweetExplanation)
-> t (Sweets, SweetExplanation) -> (Sweets, SweetExplanation)
combineSweets (Sweets, SweetExplanation)
s t (Sweets, SweetExplanation)
slm =
              -- Merge all the expectations from each of slm sweets into the main
              -- sweet s.
              ((Sweets, SweetExplanation)
 -> (Sweets, SweetExplanation) -> (Sweets, SweetExplanation))
-> (Sweets, SweetExplanation)
-> t (Sweets, SweetExplanation)
-> (Sweets, SweetExplanation)
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Sweets, SweetExplanation)
-> (Sweets, SweetExplanation) -> (Sweets, SweetExplanation)
chooseOrCombineExpectations (Sweets, SweetExplanation)
s t (Sweets, SweetExplanation)
slm
            chooseOrCombineExpectations :: (Sweets, SweetExplanation)
-> (Sweets, SweetExplanation) -> (Sweets, SweetExplanation)
chooseOrCombineExpectations (Sweets
s,SweetExplanation
e) (Sweets
sm,SweetExplanation
sme) =
              case (Sweets -> FilePath) -> Sweets -> Sweets -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing Sweets -> FilePath
rootBaseName Sweets
s Sweets
sm of
                Ordering
GT -> (Sweets
s,SweetExplanation
e)
                Ordering
LT -> (Sweets
sm, SweetExplanation
sme)
                Ordering
EQ -> (Sweets, SweetExplanation)
-> (Sweets, SweetExplanation) -> (Sweets, SweetExplanation)
forall {b}.
(Sweets, SweetExplanation)
-> (Sweets, b) -> (Sweets, SweetExplanation)
bestExpectations (Sweets
s,SweetExplanation
e) (Sweets
sm,SweetExplanation
sme)
            bestExpectations :: (Sweets, SweetExplanation)
-> (Sweets, b) -> (Sweets, SweetExplanation)
bestExpectations (Sweets
s,SweetExplanation
e) (Sweets
sm,b
_sme) =
              -- combine the expectations in s with the expectations in each of
              -- sm, where expectations overlap based on explicit expParamsMatch
              -- matchups.
              let swts :: Sweets
swts = Sweets
s { expected =
                               foldr mergeExp (expected s) (expected sm)
                           }
                  mergeExp :: Expectation -> [Expectation] -> [Expectation]
mergeExp Expectation
oneExp [Expectation]
expcts =
                    [[Expectation]] -> [Expectation]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
                    ([[Expectation]] -> [Expectation])
-> [[Expectation]] -> [Expectation]
forall a b. (a -> b) -> a -> b
$ ([Expectation] -> [Expectation])
-> [[Expectation]] -> [[Expectation]]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> [Expectation] -> [Expectation]
forall a. Int -> [a] -> [a]
take Int
1)
                    ([[Expectation]] -> [[Expectation]])
-> [[Expectation]] -> [[Expectation]]
forall a b. (a -> b) -> a -> b
$ (Expectation -> Expectation -> Bool)
-> [Expectation] -> [[Expectation]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy ([(FilePath, Maybe FilePath)]
-> [(FilePath, Maybe FilePath)] -> Bool
forall a. Eq a => a -> a -> Bool
(==) ([(FilePath, Maybe FilePath)]
 -> [(FilePath, Maybe FilePath)] -> Bool)
-> (Expectation -> [(FilePath, Maybe FilePath)])
-> Expectation
-> Expectation
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on`
                                  ((NamedParamMatch -> (FilePath, Maybe FilePath))
-> [NamedParamMatch] -> [(FilePath, Maybe FilePath)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((ParamMatch -> Maybe FilePath)
-> NamedParamMatch -> (FilePath, Maybe FilePath)
forall a b. (a -> b) -> (FilePath, a) -> (FilePath, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParamMatch -> Maybe FilePath
getParamVal) ([NamedParamMatch] -> [(FilePath, Maybe FilePath)])
-> (Expectation -> [NamedParamMatch])
-> Expectation
-> [(FilePath, Maybe FilePath)]
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 -> Expectation -> Ordering)
-> [Expectation] -> [Expectation]
forall a. (a -> a -> Ordering) -> [a] -> [a]
L.sortBy ([NamedParamMatch] -> [NamedParamMatch] -> Ordering
pmatchCmp ([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] -> [Expectation]) -> [Expectation] -> [Expectation]
forall a b. (a -> b) -> a -> b
$ Expectation
oneExp Expectation -> [Expectation] -> [Expectation]
forall a. a -> [a] -> [a]
: [Expectation]
expcts
              in ( Sweets
swts, SweetExplanation
e { results = swts } )
        in ((Sweets, SweetExplanation)
 -> [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)])
-> [(Sweets, SweetExplanation)]
-> t (Sweets, SweetExplanation)
-> [(Sweets, SweetExplanation)]
forall a b. (a -> b -> b) -> b -> t a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Sweets, SweetExplanation)
-> [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)]
combineIfRootsMatch [] t (Sweets, SweetExplanation)
swl