{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}

-- | This module provides management for tracking candidate files that might be a
-- root file, an expected file, or an associated file.

module Test.Tasty.Sugar.Candidates
  (
    candidateToPath
  , findCandidates
  , makeCandidate
  , candidateMatchPrefix
  , candidateMatchSuffix
  )
where

import           Control.Monad ( filterM, guard )
import           Data.Bifunctor ( first )
import qualified Data.List as DL
import           Data.Maybe ( fromMaybe, isNothing )
import           Numeric.Natural
import           System.Directory ( doesDirectoryExist, getCurrentDirectory
                                  , listDirectory, doesDirectoryExist )
import           System.FilePath ( (</>), isRelative, makeRelative
                                 , splitPath, takeDirectory, takeFileName)

import           Test.Tasty.Sugar.Iterations
import           Test.Tasty.Sugar.Types


-- | Given a CUBE and a target directory, find all files in that directory and
-- subdirectories that could be candidates for processing with tasty-sugar. Each
-- file is turned into a candidate via the 'makeCandidate' function.

findCandidates :: CUBE -> FilePath -> IO ([Either String CandidateFile])
findCandidates :: CUBE -> FilePath -> IO [Either FilePath CandidateFile]
findCandidates CUBE
cube FilePath
inDir =
  let collectDirEntries :: FilePath -> IO [Either FilePath CandidateFile]
collectDirEntries FilePath
d =
        let recurse :: Bool
recurse = FilePath -> FilePath
takeFileName FilePath
d FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"*"
            top :: Maybe FilePath
top = if Bool
recurse then FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> FilePath
takeDirectory FilePath
d) else Maybe FilePath
forall a. Maybe a
Nothing
            start :: FilePath
start = if Bool
recurse then FilePath -> FilePath
takeDirectory FilePath
d else FilePath
d
        in Maybe FilePath -> FilePath -> IO [Either FilePath CandidateFile]
dirListWithPaths Maybe FilePath
top FilePath
start
      dirListWithPaths :: Maybe FilePath -> FilePath -> IO [Either FilePath CandidateFile]
dirListWithPaths Maybe FilePath
topDir FilePath
d =
        -- putStrLn ("Reading " <> show d) >>
        FilePath -> IO Bool
doesDirectoryExist FilePath
d IO Bool
-> (Bool -> IO [Either FilePath CandidateFile])
-> IO [Either FilePath CandidateFile]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          Bool
True ->
            do [FilePath]
dirContents <- FilePath -> IO [FilePath]
listDirectory FilePath
d
               case Maybe FilePath
topDir of
                 Maybe FilePath
Nothing -> do
                   let mkC :: FilePath -> CandidateFile
mkC = CUBE -> FilePath -> [FilePath] -> FilePath -> CandidateFile
makeCandidate CUBE
cube FilePath
d []
                   [Either FilePath CandidateFile]
-> IO [Either FilePath CandidateFile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CandidateFile -> Either FilePath CandidateFile
forall a b. b -> Either a b
Right (CandidateFile -> Either FilePath CandidateFile)
-> (FilePath -> CandidateFile)
-> FilePath
-> Either FilePath CandidateFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CandidateFile
mkC (FilePath -> Either FilePath CandidateFile)
-> [FilePath] -> [Either FilePath CandidateFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
dirContents)
                 Just FilePath
topdir -> do
                   let subs :: [FilePath]
subs = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null)
                              (FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
init
                               (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
init (FilePath -> [FilePath]
splitPath
                                          (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
makeRelative FilePath
topdir (FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
"x")))
                   let mkC :: FilePath -> CandidateFile
mkC = CUBE -> FilePath -> [FilePath] -> FilePath -> CandidateFile
makeCandidate CUBE
cube FilePath
topdir [FilePath]
subs
                   [FilePath]
subdirs <- (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (FilePath -> IO Bool
doesDirectoryExist (FilePath -> IO Bool)
-> (FilePath -> FilePath) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
d FilePath -> FilePath -> FilePath
</>)) [FilePath]
dirContents
                   let here :: [Either a CandidateFile]
here = CandidateFile -> Either a CandidateFile
forall a b. b -> Either a b
Right (CandidateFile -> Either a CandidateFile)
-> (FilePath -> CandidateFile)
-> FilePath
-> Either a CandidateFile
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> CandidateFile
mkC (FilePath -> Either a CandidateFile)
-> [FilePath] -> [Either a CandidateFile]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
subdirs)) [FilePath]
dirContents)
                   [[Either FilePath CandidateFile]]
subCandidates <- (FilePath -> IO [Either FilePath CandidateFile])
-> [FilePath] -> IO [[Either FilePath CandidateFile]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (Maybe FilePath -> FilePath -> IO [Either FilePath CandidateFile]
dirListWithPaths Maybe FilePath
topDir)
                                    ((FilePath
d FilePath -> FilePath -> FilePath
</>) (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath]
subdirs)
                   [Either FilePath CandidateFile]
-> IO [Either FilePath CandidateFile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Either FilePath CandidateFile]
 -> IO [Either FilePath CandidateFile])
-> [Either FilePath CandidateFile]
-> IO [Either FilePath CandidateFile]
forall a b. (a -> b) -> a -> b
$ [Either FilePath CandidateFile]
forall {a}. [Either a CandidateFile]
here [Either FilePath CandidateFile]
-> [Either FilePath CandidateFile]
-> [Either FilePath CandidateFile]
forall a. Semigroup a => a -> a -> a
<> ([[Either FilePath CandidateFile]]
-> [Either FilePath CandidateFile]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Either FilePath CandidateFile]]
subCandidates)
          Bool
False -> do
            FilePath
showD <- case FilePath -> Bool
isRelative FilePath
d of
                       Bool
True -> do FilePath
cwd <- IO FilePath
getCurrentDirectory
                                  FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"[" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
cwd FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
"/]" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
d
                       Bool
False -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
d
            [Either FilePath CandidateFile]
-> IO [Either FilePath CandidateFile]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath -> Either FilePath CandidateFile
forall a b. a -> Either a b
Left (FilePath -> Either FilePath CandidateFile)
-> FilePath -> Either FilePath CandidateFile
forall a b. (a -> b) -> a -> b
$ FilePath
showD FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
" does not exist"]
  in FilePath -> IO [Either FilePath CandidateFile]
collectDirEntries FilePath
inDir


-- | Create a CandidateFile entry for this top directory, sub-paths, and
-- filename.  In addition, any Explicit parameters with known values that appear
-- in the filename are captured.  Note that:
--
-- * There may be multiple possible matches for a single parameter (e.g. the
--   value is repeated in the name or path, or an undefind value (Nothing)
--   parameter could have multiple possible values extracted from the filename.
--
-- * File name matches are preferred over sub-path matches and will occlude the
--   latter.
--
-- * All possible filename portions and sub-paths will be suggested for non-value
-- * parameters (validParams with Nothing).

makeCandidate :: CUBE -> FilePath -> [String] -> FilePath -> CandidateFile
makeCandidate :: CUBE -> FilePath -> [FilePath] -> FilePath -> CandidateFile
makeCandidate CUBE
cube FilePath
topDir [FilePath]
subPath FilePath
fName =
  let fl :: Int
fl = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
DL.length FilePath
fName
      isSep :: Char -> Bool
isSep = (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
cube)
      firstSep :: Int
firstSep = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
fl (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
DL.findIndex Char -> Bool
isSep FilePath
fName
      fle :: Int
fle = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
fl (Int
flInt -> Int -> Int
forall a. Num a => a -> a -> a
-) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
DL.findIndex Char -> Bool
isSep (FilePath -> Maybe Int) -> FilePath -> Maybe Int
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
DL.reverse FilePath
fName
      -- pmatches is all known parameter values found in the name or directory of
      -- the file.  Note that a single parameter with multiple values may result
      -- in multiple pmatches if more than one of the values is present in a
      -- single filename.
      pmatches :: [(NamedParamMatch, (Natural, Int))]
pmatches = ([(NamedParamMatch, (Natural, Int))], IterStat)
-> [(NamedParamMatch, (Natural, Int))]
forall a b. (a, b) -> a
fst (([(NamedParamMatch, (Natural, Int))], IterStat)
 -> [(NamedParamMatch, (Natural, Int))])
-> ([(NamedParamMatch, (Natural, Int))], IterStat)
-> [(NamedParamMatch, (Natural, Int))]
forall a b. (a -> b) -> a -> b
$ LogicI (NamedParamMatch, (Natural, Int))
-> ([(NamedParamMatch, (Natural, Int))], IterStat)
forall a. LogicI a -> ([a], IterStat)
observeIAll
                 (LogicI (NamedParamMatch, (Natural, Int))
 -> ([(NamedParamMatch, (Natural, Int))], IterStat))
-> LogicI (NamedParamMatch, (Natural, Int))
-> ([(NamedParamMatch, (Natural, Int))], IterStat)
forall a b. (a -> b) -> a -> b
$ do ParameterPattern
p <- Text -> [ParameterPattern] -> LogicI ParameterPattern
forall a. Text -> [a] -> LogicI a
eachFrom Text
"param for candidate" ([ParameterPattern] -> LogicI ParameterPattern)
-> [ParameterPattern] -> LogicI ParameterPattern
forall a b. (a -> b) -> a -> b
$ CUBE -> [ParameterPattern]
validParams CUBE
cube
                      FilePath
v <- Text -> [FilePath] -> LogicI FilePath
forall a. Text -> [a] -> LogicI a
eachFrom Text
"value for param" ([FilePath] -> Maybe [FilePath] -> [FilePath]
forall a. a -> Maybe a -> a
fromMaybe [] (ParameterPattern -> Maybe [FilePath]
forall a b. (a, b) -> b
snd ParameterPattern
p))
                      -- Note: there maybe multiple v values for a single p that
                      -- are matched in the name.  This is accepted here (and
                      -- this file presumably satisfies either with an Explicit
                      -- match).
                      let vl :: Int
vl = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
DL.length FilePath
v
                      Int
i <- Text -> [Int] -> LogicI Int
forall a. Text -> [a] -> LogicI a
eachFrom Text
"param starts"
                           ([Int] -> LogicI Int) -> [Int] -> LogicI Int
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> [Int]
forall a. (a -> Bool) -> [a] -> [Int]
DL.findIndices (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
cube)) FilePath
fName
                      let vs :: Int
vs = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      let ve :: Int
ve = Int
vs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vl
                      if [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Int
ve Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
fl  -- v fits in fName[i..]
                             , FilePath
v FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.take Int
vl (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.drop Int
vs FilePath
fName)
                             , FilePath -> Char
forall a. HasCallStack => [a] -> a
head (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.drop Int
ve FilePath
fName) 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
cube)
                             ]
                         then (NamedParamMatch, (Natural, Int))
-> LogicI (NamedParamMatch, (Natural, Int))
forall a. a -> LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ParameterPattern -> FilePath
forall a b. (a, b) -> a
fst ParameterPattern
p, FilePath -> ParamMatch
Explicit FilePath
v), (Int -> Natural
forall a. Enum a => Int -> a
toEnum Int
vs, Int
ve))
                        else do 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
$ FilePath
v FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
subPath
                                (NamedParamMatch, (Natural, Int))
-> LogicI (NamedParamMatch, (Natural, Int))
forall a. a -> LogicT (StateT IterStat Identity) a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ParameterPattern -> FilePath
forall a b. (a, b) -> a
fst ParameterPattern
p, FilePath -> ParamMatch
Explicit FilePath
v), (Natural
0, Int
0))
      -- pmatchArbitrary will find a parameter with an unspecified value and
      -- assigned otherwise unmatched portions of the filename to that parameter.
      pmatchArbitrary :: [(NamedParamMatch, (Natural, Int))]
pmatchArbitrary =
        case (ParameterPattern -> Bool)
-> [ParameterPattern] -> Maybe ParameterPattern
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
DL.find (Maybe [FilePath] -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe [FilePath] -> Bool)
-> (ParameterPattern -> Maybe [FilePath])
-> ParameterPattern
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParameterPattern -> Maybe [FilePath]
forall a b. (a, b) -> b
snd) ([ParameterPattern] -> Maybe ParameterPattern)
-> [ParameterPattern] -> Maybe ParameterPattern
forall a b. (a -> b) -> a -> b
$ CUBE -> [ParameterPattern]
validParams CUBE
cube of
          Maybe ParameterPattern
Nothing -> []
          Just (FilePath
p,Maybe [FilePath]
_) ->
            let chkRange :: [(Int, Int)]
chkRange = [(Int
firstSep, Int
fle)]
                -- arbs is the (start,len) spans where arbitrary values could
                -- occur
                arbs :: [(Natural, Int)]
arbs = [(Int, Int)] -> [(Natural, Int)] -> [(Natural, Int)]
holes [(Int, Int)]
chkRange ((NamedParamMatch, (Natural, Int)) -> (Natural, Int)
forall a b. (a, b) -> b
snd ((NamedParamMatch, (Natural, Int)) -> (Natural, Int))
-> [(NamedParamMatch, (Natural, Int))] -> [(Natural, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(NamedParamMatch, (Natural, Int))]
pmatches)
                -- getRange extracts a substring range from the fName
                getRange :: (a, Int) -> FilePath
getRange (a
s,Int
e) = let s' :: Int
s' = a -> Int
forall a. Enum a => a -> Int
fromEnum a
s
                                 in Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.take (Int
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
s' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.drop Int
s' FilePath
fName
                -- holeVals are the separator-divided values extracted from the
                -- arbs ranges of fName.
                holeVals :: [(FilePath, (Natural, Int))]
holeVals = let neither :: (t -> Bool) -> t -> t -> Bool
neither t -> Bool
f t
a t
b = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [t -> Bool
f t
a, t -> Bool
f t
b]
                               splitBySep :: FilePath -> [FilePath]
splitBySep = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSep)
                                            ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char -> Bool) -> FilePath -> [FilePath]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
DL.groupBy ((Char -> Bool) -> Char -> Char -> Bool
forall {t}. (t -> Bool) -> t -> t -> Bool
neither Char -> Bool
isSep)
                               rangeVals :: (a, Int) -> [(FilePath, (a, Int))]
rangeVals (a, Int)
r = (,(a, Int)
r) (FilePath -> (FilePath, (a, Int)))
-> [FilePath] -> [(FilePath, (a, Int))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> [FilePath]
splitBySep (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (a, Int) -> FilePath
forall {a}. Enum a => (a, Int) -> FilePath
getRange (a, Int)
r)
                           in
                             ((Natural, Int) -> [(FilePath, (Natural, Int))])
-> [(Natural, Int)] -> [(FilePath, (Natural, Int))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Natural, Int) -> [(FilePath, (Natural, Int))]
forall {a}. Enum a => (a, Int) -> [(FilePath, (a, Int))]
rangeVals [(Natural, Int)]
arbs
                -- dirVals are the subdirectory elements that could be used for
                -- arbitrary value matching (i.e. they don't explicitly match).
                dirVals :: [(FilePath, (Natural, Int))]
dirVals =
                  let pvals :: [Maybe FilePath]
pvals = ParamMatch -> Maybe FilePath
getParamVal (ParamMatch -> Maybe FilePath)
-> ((NamedParamMatch, (Natural, Int)) -> ParamMatch)
-> (NamedParamMatch, (Natural, Int))
-> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NamedParamMatch -> ParamMatch
forall a b. (a, b) -> b
snd (NamedParamMatch -> ParamMatch)
-> ((NamedParamMatch, (Natural, Int)) -> NamedParamMatch)
-> (NamedParamMatch, (Natural, Int))
-> ParamMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedParamMatch, (Natural, Int)) -> NamedParamMatch
forall a b. (a, b) -> a
fst ((NamedParamMatch, (Natural, Int)) -> Maybe FilePath)
-> [(NamedParamMatch, (Natural, Int))] -> [Maybe FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(NamedParamMatch, (Natural, Int))]
pmatches
                  in (, (Natural
0,Int
0)) (FilePath -> (FilePath, (Natural, Int)))
-> [FilePath] -> [(FilePath, (Natural, Int))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe FilePath -> [Maybe FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Maybe FilePath]
pvals) (Maybe FilePath -> Bool)
-> (FilePath -> Maybe FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just) [FilePath]
subPath
            in ((FilePath -> NamedParamMatch)
-> (FilePath, (Natural, Int)) -> (NamedParamMatch, (Natural, Int))
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 ((FilePath
p,) (ParamMatch -> NamedParamMatch)
-> (FilePath -> ParamMatch) -> FilePath -> NamedParamMatch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ParamMatch
Explicit)) ((FilePath, (Natural, Int)) -> (NamedParamMatch, (Natural, Int)))
-> [(FilePath, (Natural, Int))]
-> [(NamedParamMatch, (Natural, Int))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([(FilePath, (Natural, Int))]
holeVals [(FilePath, (Natural, Int))]
-> [(FilePath, (Natural, Int))] -> [(FilePath, (Natural, Int))]
forall a. Semigroup a => a -> a -> a
<> [(FilePath, (Natural, Int))]
dirVals)
      pAll :: [(NamedParamMatch, (Natural, Int))]
pAll = [(NamedParamMatch, (Natural, Int))]
pmatches [(NamedParamMatch, (Natural, Int))]
-> [(NamedParamMatch, (Natural, Int))]
-> [(NamedParamMatch, (Natural, Int))]
forall a. Semigroup a => a -> a -> a
<> [(NamedParamMatch, (Natural, Int))]
pmatchArbitrary
      dropSeps :: a -> a
dropSeps a
i =
        let lst :: FilePath
lst = [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
last ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
forall a. Eq a => [a] -> [[a]]
DL.group (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.take (a -> Int
forall a. Enum a => a -> Int
fromEnum a
i) FilePath
fName
        in if Char -> Bool
isSep (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
lst
           then a
i a -> a -> a
forall a. Num a => a -> a -> a
- (Int -> a
forall a. Enum a => Int -> a
toEnum (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
lst) a -> a -> a
forall a. Num a => a -> a -> a
- a
1)
           else a
i
      mtchIdx :: Natural
mtchIdx = Natural -> Natural
forall {a}. (Num a, Enum a) => a -> a
dropSeps
                (Natural -> Natural) -> Natural -> Natural
forall a b. (a -> b) -> a -> b
$ [Natural] -> Natural
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
                ([Natural] -> Natural) -> [Natural] -> Natural
forall a b. (a -> b) -> a -> b
$ Int -> Natural
forall a. Enum a => Int -> a
toEnum Int
fle
                Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: (Natural -> Bool) -> [Natural] -> [Natural]
forall a. (a -> Bool) -> [a] -> [a]
filter (Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
/= Natural
0) ((Natural, Int) -> Natural
forall a b. (a, b) -> a
fst ((Natural, Int) -> Natural)
-> ((NamedParamMatch, (Natural, Int)) -> (Natural, Int))
-> (NamedParamMatch, (Natural, Int))
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NamedParamMatch, (Natural, Int)) -> (Natural, Int)
forall a b. (a, b) -> b
snd ((NamedParamMatch, (Natural, Int)) -> Natural)
-> [(NamedParamMatch, (Natural, Int))] -> [Natural]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(NamedParamMatch, (Natural, Int))]
pAll)
  in CandidateFile { candidateDir :: FilePath
candidateDir = FilePath
topDir
                   , candidateSubdirs :: [FilePath]
candidateSubdirs = [FilePath]
subPath
                   , candidateFile :: FilePath
candidateFile = FilePath
fName
                   -- nub the results in case a v value appears twice in a single
                   -- file.  Sort the results for stability in testing.
                   , candidatePMatch :: [NamedParamMatch]
candidatePMatch = [NamedParamMatch] -> [NamedParamMatch]
forall a. Eq a => [a] -> [a]
DL.nub ([NamedParamMatch] -> [NamedParamMatch])
-> [NamedParamMatch] -> [NamedParamMatch]
forall a b. (a -> b) -> a -> b
$ [NamedParamMatch] -> [NamedParamMatch]
forall a. Ord a => [a] -> [a]
DL.sort ([NamedParamMatch] -> [NamedParamMatch])
-> [NamedParamMatch] -> [NamedParamMatch]
forall a b. (a -> b) -> a -> b
$ ((NamedParamMatch, (Natural, Int)) -> NamedParamMatch
forall a b. (a, b) -> a
fst ((NamedParamMatch, (Natural, Int)) -> NamedParamMatch)
-> [(NamedParamMatch, (Natural, Int))] -> [NamedParamMatch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(NamedParamMatch, (Natural, Int))]
pAll)
                   , candidateMatchIdx :: Natural
candidateMatchIdx = Natural
mtchIdx
                   }


-- Remove present from chkRange leaving holes.
holes :: [(Int,Int)] -> [(Natural,Int)] -> [(Natural,Int)]
holes :: [(Int, Int)] -> [(Natural, Int)] -> [(Natural, Int)]
holes [(Int, Int)]
chkRange [(Natural, Int)]
present =
  let rmvKnown :: (a, Int) -> [(a, Int)] -> [(a, Int)]
rmvKnown (a, Int)
_ [] = []
      rmvKnown p :: (a, Int)
p@(a
ps,Int
pe) ((a
s,Int
e):[(a, Int)]
rs) =
        if Int -> Int
forall a. Num a => a -> a
abs(a -> Int
forall a. Enum a => a -> Int
fromEnum a
ps Int -> Int -> Int
forall a. Num a => a -> a -> a
- a -> Int
forall a. Enum a => a -> Int
fromEnum a
s) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
        then if Int
pe Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
e
             then (a, Int) -> [(a, Int)] -> [(a, Int)]
rmvKnown (Int -> a
forall a. Enum a => Int -> a
toEnum Int
e,Int
pe) [(a, Int)]
rs
             else if Int -> Int
forall a. Num a => a -> a
abs(Int
peInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
e) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                  then [(a, Int)]
rs
                  else (Int -> a
forall a. Enum a => Int -> a
toEnum Int
pe a -> a -> a
forall a. Num a => a -> a -> a
+ a
1, Int
e) (a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
: [(a, Int)]
rs
        else if a
ps a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
s Bool -> Bool -> Bool
&& a -> Int
forall a. Enum a => a -> Int
fromEnum a
ps Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e
             then if Int -> Int
forall a. Num a => a -> a
abs(Int
pe Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
e) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
                  then (a
s, a -> Int
forall a. Enum a => a -> Int
fromEnum a
ps) (a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
: [(a, Int)]
rs
                  else if Int
pe Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
e
                       then (a
s, a -> Int
forall a. Enum a => a -> Int
fromEnum a
ps) (a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
: (Int -> a
forall a. Enum a => Int -> a
toEnum Int
pe, Int
e) (a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
: [(a, Int)]
rs
                       else (a
s, a -> Int
forall a. Enum a => a -> Int
fromEnum a
ps) (a, Int) -> [(a, Int)] -> [(a, Int)]
forall a. a -> [a] -> [a]
: (a, Int) -> [(a, Int)] -> [(a, Int)]
rmvKnown (Int -> a
forall a. Enum a => Int -> a
toEnum Int
e, Int
pe) [(a, Int)]
rs
             else (a, Int) -> [(a, Int)] -> [(a, Int)]
rmvKnown (a, Int)
p [(a, Int)]
rs
      r' :: [(Int, Int)]
r' = ((Int, Int) -> Bool) -> [(Int, Int)] -> [(Int, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Int, Int)
x -> (Int, Int) -> Int
forall a b. (a, b) -> a
fst (Int, Int)
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= (Int, Int) -> Int
forall a b. (a, b) -> b
snd (Int, Int)
x) [(Int, Int)]
chkRange
      p' :: [(Natural, Int)]
p' = ((Natural, Int) -> Bool) -> [(Natural, Int)] -> [(Natural, Int)]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(Natural
x,Int
y) -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Natural
x Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0, Int
y Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 ]) [(Natural, Int)]
present
  in ((Natural, Int) -> [(Natural, Int)] -> [(Natural, Int)])
-> [(Natural, Int)] -> [(Natural, Int)] -> [(Natural, Int)]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Natural, Int) -> [(Natural, Int)] -> [(Natural, Int)]
forall {a}.
(Enum a, Num a, Ord a) =>
(a, Int) -> [(a, Int)] -> [(a, Int)]
rmvKnown ((Int -> Natural) -> (Int, Int) -> (Natural, Int)
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 Int -> Natural
forall a. Enum a => Int -> a
toEnum ((Int, Int) -> (Natural, Int)) -> [(Int, Int)] -> [(Natural, Int)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Int)]
r') ([(Natural, Int)] -> [(Natural, Int)]
forall a. Ord a => [a] -> [a]
DL.sort [(Natural, Int)]
p')


-- | This converts a CandidateFile into a regular FilePath for access by standard
-- IO operations.

candidateToPath :: CandidateFile -> FilePath
candidateToPath :: CandidateFile -> FilePath
candidateToPath CandidateFile
c =
  CandidateFile -> FilePath
candidateDir CandidateFile
c FilePath -> FilePath -> FilePath
</> (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
(</>) (CandidateFile -> FilePath
candidateFile CandidateFile
c) (CandidateFile -> [FilePath]
candidateSubdirs CandidateFile
c)


-- | Determines if the second CandidateFile argument matches the prefix of the
-- first CandidateFile, up to any separator (if applicable).  This can be used to
-- match possible expected files against the current root file, or possible
-- associated files against the current expected file.
candidateMatchPrefix :: Separators -> CandidateFile -> CandidateFile -> Bool
candidateMatchPrefix :: FilePath -> CandidateFile -> CandidateFile -> Bool
candidateMatchPrefix FilePath
seps CandidateFile
mf CandidateFile
cf =
  let mStart :: FilePath
mStart = CandidateFile -> FilePath
candidateFile CandidateFile
mf
      mStartLen :: Int
mStartLen = FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
mStart
      f :: FilePath
f = CandidateFile -> FilePath
candidateFile CandidateFile
cf
      pfxlen :: Natural
pfxlen = let cl :: Natural
cl = CandidateFile -> Natural
candidateMatchIdx CandidateFile
cf
               in if Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
cl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f
                  then if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
seps then Int -> Natural
forall a. Enum a => Int -> a
toEnum Int
mStartLen else Natural
cl
                  else Natural
cl Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1
  in FilePath
mStart FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.take (Natural -> Int
forall a. Enum a => a -> Int
fromEnum Natural
pfxlen) FilePath
f


-- | Determines if the second candidate file matches the first by virtue of
-- having the same identified suffix.  If a non-null suffix is specified then
-- verify the second file is the conjunction of the first file with a separator
-- and the specified suffix with appropriate considerations for any separator in
-- the supplied suffix.  If no suffix is provided, then simply ensure that the
-- second file has no suffix.

candidateMatchSuffix :: Separators -> FileSuffix -> CandidateFile
                     -> CandidateFile -> Bool
candidateMatchSuffix :: FilePath -> FilePath -> CandidateFile -> CandidateFile -> Bool
candidateMatchSuffix FilePath
seps FilePath
sfx CandidateFile
rootf CandidateFile
cf =
  let f :: FilePath
f = CandidateFile -> FilePath
candidateFile CandidateFile
cf
      sfxsep :: Bool
sfxsep = Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
sfx) Bool -> Bool -> Bool
&& FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
sfx Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
seps
  in if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
sfx
     then FilePath
f FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
DL.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
seps)) FilePath
f
     else [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CandidateFile -> FilePath
candidateFile CandidateFile
rootf) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
sfx)
              , FilePath
sfx FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`DL.isSuffixOf` FilePath
f
                -- is char before sfx a separator (and fEnd didn't start
                -- with a separator)?
              , if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
seps
                then FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (CandidateFile -> FilePath
candidateFile CandidateFile
rootf) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
sfx
                else if Bool
sfxsep
                     then Bool
True
                     else Bool
-> ((Char, FilePath) -> Bool) -> Maybe (Char, FilePath) -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False ((Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
seps) (Char -> Bool)
-> ((Char, FilePath) -> Char) -> (Char, FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char, FilePath) -> Char
forall a b. (a, b) -> a
fst)
                          (Maybe (Char, FilePath) -> Bool) -> Maybe (Char, FilePath) -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe (Char, FilePath)
forall a. [a] -> Maybe (a, [a])
DL.uncons
                          (FilePath -> Maybe (Char, FilePath))
-> FilePath -> Maybe (Char, FilePath)
forall a b. (a -> b) -> a -> b
$ Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
DL.drop (FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
sfx)
                          (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
f
              ]