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

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

import           Control.Monad.Logic
import           Data.Bifunctor ( bimap )
import           Data.Maybe ( catMaybes )
import qualified System.FilePath as FP
import qualified System.FilePath.GlobPattern as FPGP

import           Test.Tasty.Sugar.ExpectCheck
import           Test.Tasty.Sugar.RootCheck
import           Test.Tasty.Sugar.Types


-- | Given a 'CUBE' and a list of files in the target directory,
-- 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 -> [FilePath]
           -> (Int, [([Sweets], [SweetExplanation])])
checkRoots :: CUBE -> [FilePath] -> (Int, [([Sweets], [SweetExplanation])])
checkRoots CUBE
pat [FilePath]
allFiles =
  let isRootMatch :: FilePath -> Bool
isRootMatch FilePath
n = FilePath
n FilePath -> FilePath -> Bool
FPGP.~~ (CUBE -> FilePath
rootName CUBE
pat)
      rootNames :: [FilePath]
rootNames = FilePath -> FilePath
FP.takeFileName (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
isRootMatch [FilePath]
allFiles)
  in ([FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
rootNames, (FilePath -> ([Sweets], [SweetExplanation]))
-> [FilePath] -> [([Sweets], [SweetExplanation])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CUBE -> [FilePath] -> FilePath -> ([Sweets], [SweetExplanation])
checkRoot CUBE
pat [FilePath]
allFiles) [FilePath]
rootNames)


-- 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
          -> [FilePath] --  all possible expect candidates
          -> FilePath  --  root name
          -> ([Sweets], [SweetExplanation])
checkRoot :: CUBE -> [FilePath] -> FilePath -> ([Sweets], [SweetExplanation])
checkRoot CUBE
pat [FilePath]
allNames FilePath
rootNm =
  let seps :: FilePath
seps = CUBE -> FilePath
separators CUBE
pat
      params :: [ParameterPattern]
params = 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 (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]
:)

      trimSweets :: [(Sweets, SweetExplanation)] ->
                    [(Sweets, SweetExplanation)]
      trimSweets :: [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)]
trimSweets =
        -- If multiple Sweets have the same rootMatchName, use the one
        -- with the longer rootBaseName.  This prevents "foo.exp" and
        -- "foo-bar.exp" from both matching "foo-bar.c".
        (\[(Sweets, SweetExplanation)]
l -> let removeShorterBases :: [(Sweets, b)] -> (Sweets, b) -> [(Sweets, b)]
removeShorterBases [(Sweets, b)]
lst (Sweets
entry,b
_) =
                     let notShorterBase :: (Sweets, b) -> Bool
notShorterBase (Sweets
s,b
_) = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$
                           [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Sweets -> FilePath
rootMatchName Sweets
s FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Sweets -> FilePath
rootMatchName Sweets
entry
                               , Sweets -> FilePath
rootBaseName Sweets
s FilePath -> FilePath -> Bool
forall a. Ord a => a -> a -> Bool
< Sweets -> FilePath
rootBaseName Sweets
entry
                               ]
                     in ((Sweets, b) -> Bool) -> [(Sweets, b)] -> [(Sweets, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Sweets, b) -> Bool
forall b. (Sweets, b) -> Bool
notShorterBase [(Sweets, b)]
lst
               in ([(Sweets, SweetExplanation)]
 -> (Sweets, SweetExplanation) -> [(Sweets, SweetExplanation)])
-> [(Sweets, SweetExplanation)]
-> [(Sweets, SweetExplanation)]
-> [(Sweets, SweetExplanation)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(Sweets, SweetExplanation)]
-> (Sweets, SweetExplanation) -> [(Sweets, SweetExplanation)]
forall b b. [(Sweets, b)] -> (Sweets, b) -> [(Sweets, b)]
removeShorterBases [(Sweets, SweetExplanation)]
l [(Sweets, SweetExplanation)]
l)

  in ((Sweets, SweetExplanation)
 -> ([Sweets], [SweetExplanation])
 -> ([Sweets], [SweetExplanation]))
-> ([Sweets], [SweetExplanation])
-> [(Sweets, SweetExplanation)]
-> ([Sweets], [SweetExplanation])
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, SweetExplanation)] -> ([Sweets], [SweetExplanation]))
-> [(Sweets, SweetExplanation)] -> ([Sweets], [SweetExplanation])
forall a b. (a -> b) -> a -> b
$
     [(Sweets, SweetExplanation)] -> [(Sweets, SweetExplanation)]
trimSweets ([(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)]
 -> [(Sweets, SweetExplanation)])
-> [Maybe (Sweets, SweetExplanation)]
-> [(Sweets, SweetExplanation)]
forall a b. (a -> b) -> a -> b
$
     (([NamedParamMatch], FilePath, FilePath)
 -> Maybe (Sweets, SweetExplanation))
-> [([NamedParamMatch], FilePath, FilePath)]
-> [Maybe (Sweets, SweetExplanation)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CUBE
-> FilePath
-> [FilePath]
-> ([NamedParamMatch], FilePath, FilePath)
-> Maybe (Sweets, SweetExplanation)
findExpectation CUBE
pat FilePath
rootNm [FilePath]
allNames) ([([NamedParamMatch], FilePath, FilePath)]
 -> [Maybe (Sweets, SweetExplanation)])
-> [([NamedParamMatch], FilePath, FilePath)]
-> [Maybe (Sweets, SweetExplanation)]
forall a b. (a -> b) -> a -> b
$
     Logic ([NamedParamMatch], FilePath, FilePath)
-> [([NamedParamMatch], FilePath, FilePath)]
forall a. Logic a -> [a]
observeAll (Logic ([NamedParamMatch], FilePath, FilePath)
 -> [([NamedParamMatch], FilePath, FilePath)])
-> Logic ([NamedParamMatch], FilePath, FilePath)
-> [([NamedParamMatch], FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$
     FilePath
-> FilePath
-> [ParameterPattern]
-> FilePath
-> Logic ([NamedParamMatch], FilePath, FilePath)
rootMatch FilePath
rootNm FilePath
seps [ParameterPattern]
params (CUBE -> FilePath
rootName CUBE
pat)