{-# LANGUAGE LambdaCase #-}

-- | Functions for checking different parameter/value combinations.

module Test.Tasty.Sugar.ParamCheck
  (
    eachFrom
  , getPVals
  , singlePVals
  , pvalMatch
  , removePVals
  , pmatchCmp
  , pmatchMax
  , dirMatches
  , inEachNothing
  , isCompatible
  )
  where

import           Control.Monad
import           Control.Monad.Logic
import           Data.Function ( on )
import qualified Data.List as L
import           Data.Maybe ( catMaybes, fromJust, isNothing, listToMaybe )
import           Data.Bifunctor ( first )
import           Data.Maybe ( fromMaybe )

import           Test.Tasty.Sugar.Types


-- | Core Logic function to iteratively return elements of a list via
-- backtracking.
eachFrom :: [a] -> Logic a
eachFrom :: forall a. [a] -> Logic a
eachFrom = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
mplus forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Monad m => a -> m a
return) forall (m :: * -> *) a. MonadPlus m => m a
mzero


-- | Returns various combinations of parameter value selections
getPVals :: [ParameterPattern] -> Logic [(String, Maybe String)]
getPVals :: [ParameterPattern] -> Logic [(String, Maybe String)]
getPVals = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {a} {a}. (a, Maybe [a]) -> LogicT Identity (a, Maybe a)
getPVal
  where
    getPVal :: (a, Maybe [a]) -> LogicT Identity (a, Maybe a)
getPVal (a
pn, Maybe [a]
Nothing) = forall (m :: * -> *) a. Monad m => a -> m a
return (a
pn, forall a. Maybe a
Nothing)
    getPVal (a
pn, Just [a]
pv) = do a
pv' <- forall a. [a] -> Logic a
eachFrom [a]
pv
                               forall (m :: * -> *) a. Monad m => a -> m a
return (a
pn, forall a. a -> Maybe a
Just a
pv')

-- | Returns a ParameterPattern admitting only a single value for each parameter,
-- ensuring that the value is compatible with any existing NamedParamMatch.  This
-- is useful for callers wishing to handle each combination of parameter values
-- separately.
singlePVals :: [NamedParamMatch] -> [ParameterPattern]
            -> Logic [ParameterPattern]
singlePVals :: [NamedParamMatch] -> [ParameterPattern] -> Logic [ParameterPattern]
singlePVals [NamedParamMatch]
sel = [ParameterPattern] -> Logic [ParameterPattern]
eachVal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
L.sort
  where eachVal :: [ParameterPattern] -> Logic [ParameterPattern]
eachVal [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
        eachVal ((String
pn,Maybe [String]
Nothing):[ParameterPattern]
ps) =
          let this :: ParameterPattern
this = (String
pn, (forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn [NamedParamMatch]
sel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParamMatch -> Maybe String
getParamVal))
           in (ParameterPattern
this forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParameterPattern] -> Logic [ParameterPattern]
eachVal [ParameterPattern]
ps
        eachVal ((String
pn,Just [String]
pvs):[ParameterPattern]
ps) =
          do String
pv <- forall a. [a] -> Logic a
eachFrom forall a b. (a -> b) -> a -> b
$ case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn [NamedParamMatch]
sel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParamMatch -> Maybe String
getParamVal of
                                Maybe String
Nothing -> forall a. Ord a => [a] -> [a]
L.sort [String]
pvs
                                Just String
v -> [String
v]
             ((String
pn, forall a. a -> Maybe a
Just [String
pv]) forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParameterPattern] -> Logic [ParameterPattern]
eachVal [ParameterPattern]
ps


-- | Generate each possible combination of Explicit or non-Explicit
-- (Assumed or NotSpecified) parameter value and the corresponding
-- string with each combination of separators.  The string will be
-- used to match against input files.
--
-- Note that valid combinations require that if a parameter is
-- non-Explicit, all following parameters must also be non-Explicit.
--
-- The preset set of parameters are any parameters *already* matched
-- against (usually in the rootName); these parameters may or may not
-- be present in the filename matched from the output of this
-- function, but if they are present, they must have the values
-- specified in the preset (instead of having any of the possible
-- values allowed for that parameter).
--
-- It's also possible that since this returns varying combinations of
-- parameters, that there may be multiple files that will match
-- against these combinations.  Therefore, the results also indicate
-- how many of the parameters are used in the associated matching
-- string since the caller will usually select the match with the
-- highest ranking (number of matched parameters) in the filename.
-- [Note that it is not possibly to simply use the length of the
-- @[NamedParamMatch]@ return component since that may contain values
-- from the preset that don't actually occur in the match string.
pvalMatch :: Separators
          -> [NamedParamMatch]
          -> [(String, Maybe String)]
          -> Logic ([NamedParamMatch], Int, String)
pvalMatch :: String
-> [NamedParamMatch]
-> [(String, Maybe String)]
-> Logic ([NamedParamMatch], Int, String)
pvalMatch String
seps [NamedParamMatch]
preset [(String, Maybe String)]
pvals =
  let ([(String, Maybe String)]
ppv, [(String, Maybe String)]
_rpv) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition forall {b}. (String, b) -> Bool
isPreset [(String, Maybe String)]
pvals
      isPreset :: (String, b) -> Bool
isPreset (String, b)
p = forall a b. (a, b) -> a
fst (String, b)
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [NamedParamMatch]
preset)

      matchesPreset :: Bool
matchesPreset = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (String, Maybe String) -> Bool
matchPreset [(String, Maybe String)]
ppv
      matchPreset :: (String, Maybe String) -> Bool
matchPreset (String
pn,Maybe String
mpv) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Maybe String -> ParamMatch -> Bool
matchPresetVal Maybe String
mpv) forall a b. (a -> b) -> a -> b
$
                             forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn [NamedParamMatch]
preset
      matchPresetVal :: Maybe String -> ParamMatch -> Bool
matchPresetVal Maybe String
mpv ParamMatch
pv = case Maybe String
mpv of
                                Just String
v -> String -> ParamMatch -> Bool
paramMatchVal String
v ParamMatch
pv
                                Maybe String
Nothing -> Bool
True

      genPVStr :: [NamedParamMatch] -> Logic String
      genPVStr :: [NamedParamMatch] -> Logic String
genPVStr [NamedParamMatch]
pvs =
        let vstr :: (a, ParamMatch) -> String
vstr = forall a. a -> Maybe a -> a
fromMaybe String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParamMatch -> Maybe String
getExplicit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
            sepJoin :: String -> NamedParamMatch -> Logic String
            sepJoin :: String -> NamedParamMatch -> Logic String
sepJoin String
r NamedParamMatch
v = if ParamMatch -> Bool
isExplicit (forall a b. (a, b) -> b
snd NamedParamMatch
v)
                          then do Char
s <- forall a. [a] -> Logic a
eachFrom String
seps
                                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [Char
s] forall a. Semigroup a => a -> a -> a
<> forall {a}. (a, ParamMatch) -> String
vstr NamedParamMatch
v forall a. Semigroup a => a -> a -> a
<> String
r
                          else forall (m :: * -> *) a. Monad m => a -> m a
return String
r
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
seps
           then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\NamedParamMatch
v String
r -> forall {a}. (a, ParamMatch) -> String
vstr NamedParamMatch
v forall a. Semigroup a => a -> a -> a
<> String
r) String
"" [NamedParamMatch]
pvs
           else do Char
s <- forall a. [a] -> Logic a
eachFrom String
seps
                   forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM String -> NamedParamMatch -> Logic String
sepJoin [Char
s] [NamedParamMatch]
pvs

  in do forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Bool
matchesPreset
        [NamedParamMatch]
candidateVals <- [NamedParamMatch]
-> [(String, Maybe String)] -> Logic [NamedParamMatch]
pvVals [NamedParamMatch]
preset [(String, Maybe String)]
pvals
        let rset :: [NamedParamMatch]
rset = [NamedParamMatch]
preset forall a. Semigroup a => a -> a -> a
<> forall a b. [(String, a)] -> [(String, b)] -> [(String, a)]
removePVals [NamedParamMatch]
candidateVals [NamedParamMatch]
preset
            orderedRset :: [NamedParamMatch]
orderedRset = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> NamedParamMatch
from_rset forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst [(String, Maybe String)]
pvals
            from_rset :: String -> NamedParamMatch
from_rset String
n = let v :: ParamMatch
v = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ParamMatch
NotSpecified forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
L.lookup String
n [NamedParamMatch]
rset in (String
n,ParamMatch
v)
        String
pvstr <- [NamedParamMatch] -> Logic String
genPVStr [NamedParamMatch]
orderedRset
        forall (m :: * -> *) a. Monad m => a -> m a
return ([NamedParamMatch]
rset, forall (t :: * -> *) a. Foldable t => t a -> Int
length [NamedParamMatch]
orderedRset, String
pvstr)


-- | Generate the various combinations of parameters+values from the possible
-- set specified by the input.

pvVals :: [NamedParamMatch] -> [(String, Maybe String)] -> Logic [NamedParamMatch]
pvVals :: [NamedParamMatch]
-> [(String, Maybe String)] -> Logic [NamedParamMatch]
pvVals [NamedParamMatch]
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
pvVals [NamedParamMatch]
presets ((String
pn, Maybe String
mpv):[(String, Maybe String)]
ps) =
  do [NamedParamMatch]
nxt <- [NamedParamMatch]
-> [(String, Maybe String)] -> Logic [NamedParamMatch]
pvVals [NamedParamMatch]
presets [(String, Maybe String)]
ps
     let explicit :: String -> m [NamedParamMatch]
explicit String
v = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String
pn, String -> ParamMatch
Explicit String
v) forall a. a -> [a] -> [a]
: [NamedParamMatch]
nxt
         notExplicit :: Logic [NamedParamMatch]
notExplicit = let pMatchImpl :: Maybe String -> ParamMatch
pMatchImpl =
                             case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn [NamedParamMatch]
presets of
                               Maybe ParamMatch
Nothing -> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ParamMatch
NotSpecified String -> ParamMatch
Assumed
                               Just ParamMatch
presetV -> forall a b. a -> b -> a
const ParamMatch
presetV
                       in forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (String
pn, Maybe String -> ParamMatch
pMatchImpl Maybe String
mpv) forall a. a -> [a] -> [a]
: [NamedParamMatch]
nxt
     (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. MonadPlus m => m a
mzero forall {m :: * -> *}. Monad m => String -> m [NamedParamMatch]
explicit Maybe String
mpv) forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` Logic [NamedParamMatch]
notExplicit


-- | Removes the second set of named params from the first set, leaving the
-- remainder of the first set that isn't matched in the second set.

removePVals :: [(String, a)] -> [(String, b)] -> [(String, a)]
removePVals :: forall a b. [(String, a)] -> [(String, b)] -> [(String, a)]
removePVals [(String, a)]
main [(String, b)]
rmv = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, b)]
rmv)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(String, a)]
main


-- | This provides an Ordering result of comparing two sets of NamedParamMatch.
-- This can be used for sorting or other prioritization of named matches.

pmatchCmp :: [ NamedParamMatch ] -> [ NamedParamMatch ] -> Ordering
pmatchCmp :: [NamedParamMatch] -> [NamedParamMatch] -> Ordering
pmatchCmp [NamedParamMatch]
p1 [NamedParamMatch]
p2 =
  let comparisons :: [[NamedParamMatch] -> [NamedParamMatch] -> Ordering]
comparisons =
        [
          -- the one with more Explicit matches is better
          forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (ParamMatch -> Bool
isExplicit forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd))
          -- the one with more parameters (usually the same)
        , forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall (t :: * -> *) a. Foldable t => t a -> Int
length
          -- comparing keys
        , forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a. Ord a => [a] -> [a]
L.sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst)
        ]
        -- comparing the correlated ParamMatch values
        forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (\String
k -> forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
k)) (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedParamMatch]
p1)
  in forall a. [a -> a -> Ordering] -> a -> a -> Ordering
cascadeCompare [[NamedParamMatch] -> [NamedParamMatch] -> Ordering]
comparisons [NamedParamMatch]
p1 [NamedParamMatch]
p2

cascadeCompare :: [ a -> a -> Ordering ] -> a -> a -> Ordering
cascadeCompare :: forall a. [a -> a -> Ordering] -> a -> a -> Ordering
cascadeCompare [] a
_ a
_ = Ordering
EQ
cascadeCompare (a -> a -> Ordering
o:[a -> a -> Ordering]
os) a
a a
b = case a -> a -> Ordering
o a
a a
b of
                              Ordering
EQ -> forall a. [a -> a -> Ordering] -> a -> a -> Ordering
cascadeCompare [a -> a -> Ordering]
os a
a a
b
                              Ordering
x -> Ordering
x

-- | Returns the maximum of two arguments based on comparing the
-- [NamedParamMatch] extracted from each argument (via the passed function).

pmatchMax :: (a -> [NamedParamMatch]) -> a -> a -> a
pmatchMax :: forall a. (a -> [NamedParamMatch]) -> a -> a -> a
pmatchMax a -> [NamedParamMatch]
f a
a a
b = case [NamedParamMatch] -> [NamedParamMatch] -> Ordering
pmatchCmp (a -> [NamedParamMatch]
f a
a) (a -> [NamedParamMatch]
f a
b) of
                    Ordering
LT -> a
b
                    Ordering
_ -> a
a


-- | Given the root directory and a file in that directory, along with the
-- possible parameters and values, return each valid set of parameter matches
-- from that file, along with the remaining unmatched parameter possibilities.
--
-- The first set of parameters is the total set, and the second set represents
-- those that could be identified in the path subdirs; this is needed to prevent
-- a wildcard ParameterPattern in the second set from matching values explicit to
-- other parameters.

dirMatches :: CandidateFile -> [ParameterPattern] -> [ParameterPattern]
           -> Logic ([NamedParamMatch], [ParameterPattern])
dirMatches :: CandidateFile
-> [ParameterPattern]
-> [ParameterPattern]
-> Logic ([NamedParamMatch], [ParameterPattern])
dirMatches CandidateFile
fname [ParameterPattern]
fullParams [ParameterPattern]
params = do
  let pathPart :: [String]
pathPart = CandidateFile -> [String]
candidateSubdirs CandidateFile
fname

  let findVMatch :: FilePath -> (String, Maybe [String]) -> Maybe String
      findVMatch :: String -> ParameterPattern -> Maybe String
findVMatch String
e (String
pn,Maybe [String]
pv) =
        case Maybe [String]
pv of
          Maybe [String]
Nothing -> forall a. Maybe a
Nothing
          Just [String]
vs -> if String
e forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
vs then forall a. a -> Maybe a
Just String
pn else forall a. Maybe a
Nothing
  let findPVMatch :: [ParameterPattern] -> String -> [Maybe String] -> [Maybe String]
findPVMatch [ParameterPattern]
parms String
pthPartE [Maybe String]
found =
        forall a. [a] -> Maybe a
listToMaybe (forall a. [Maybe a] -> [a]
catMaybes (forall a b. (a -> b) -> [a] -> [b]
map (String -> ParameterPattern -> Maybe String
findVMatch String
pthPartE) [ParameterPattern]
parms)) forall a. a -> [a] -> [a]
: [Maybe String]
found

  let pmatches :: [Maybe String]
pmatches = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([ParameterPattern] -> String -> [Maybe String] -> [Maybe String]
findPVMatch [ParameterPattern]
params) [] [String]
pathPart

  let freeParam :: Maybe String
freeParam = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find (forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [ParameterPattern]
params

  let freeParts :: [Bool]
freeParts =
        let allpvals :: [String]
allpvals = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParameterPattern]
fullParams)
        in (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
allpvals)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
pathPart

  [NamedParamMatch]
dmatch <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> ParamMatch
Explicit)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall a. HasCallStack => Maybe a -> a
fromJust)
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. [a] -> [b] -> [(a, b)]
zip [Maybe String]
pmatches [String]
pathPart))
                 forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
                 (forall a b. Maybe a -> [(Maybe a, Bool, b)] -> Logic [(Maybe a, b)]
inEachNothing Maybe String
freeParam forall a b. (a -> b) -> a -> b
$ forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Maybe String]
pmatches [Bool]
freeParts [String]
pathPart))

  let drem :: [ParameterPattern]
drem = forall a b. [(String, a)] -> [(String, b)] -> [(String, a)]
removePVals [ParameterPattern]
params [NamedParamMatch]
dmatch

  forall (m :: * -> *) a. Monad m => a -> m a
return ([NamedParamMatch]
dmatch, [ParameterPattern]
drem)


-- | Return each substitution of the first argument for each location in the
-- second list that has a Nothing label and a True parameter; leave non-Nothings
-- in the second list unchanged.

inEachNothing :: Maybe a -> [(Maybe a,Bool,b)] -> Logic [(Maybe a,b)]
inEachNothing :: forall a b. Maybe a -> [(Maybe a, Bool, b)] -> Logic [(Maybe a, b)]
inEachNothing Maybe a
mark [(Maybe a, Bool, b)]
into = do
  let canSubst :: (Maybe a, Bool, c) -> Bool
canSubst (Maybe a
a,Bool
b,c
_) = Bool
b Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe a
a
  let spots :: [Int]
spots = forall a. (a -> Bool) -> [a] -> [a]
filter (\Int
i -> forall {a} {c}. (Maybe a, Bool, c) -> Bool
canSubst ([(Maybe a, Bool, b)]
into forall a. [a] -> Int -> a
!! Int
i)) forall a b. (a -> b) -> a -> b
$ [Int
0..(forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Maybe a, Bool, b)]
into) forall a. Num a => a -> a -> a
- Int
1]
  Int
i <- forall a. [a] -> Logic a
eachFrom [Int]
spots
  let deBool :: (a, b, b) -> (a, b)
deBool (a
a,b
_,b
c) = (a
a,b
c)
  let thrd :: (a, b, c) -> c
thrd (a
_,b
_,c
c) = c
c
  forall (m :: * -> *) a. Monad m => a -> m a
return
    forall a b. (a -> b) -> a -> b
$ (forall {a} {b} {b}. (a, b, b) -> (a, b)
deBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> [a] -> [a]
take Int
i [(Maybe a, Bool, b)]
into)
    forall a. Semigroup a => a -> a -> a
<> [ (Maybe a
mark, forall {a} {b} {c}. (a, b, c) -> c
thrd ([(Maybe a, Bool, b)]
into forall a. [a] -> Int -> a
!! Int
i)) ]
    forall a. Semigroup a => a -> a -> a
<> (forall {a} {b} {b}. (a, b, b) -> (a, b)
deBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> [a] -> [a]
drop (Int
i forall a. Num a => a -> a -> a
+ Int
1) [(Maybe a, Bool, b)]
into)


-- | isCompatible can be used as a filter predicate to determine if the specified
-- file is compatible with the provided parameters and chosen parameter values.
-- One principle compatibility check is ensuring that there is no *other*
-- parameter value in the filename that conflicts with a chosen parameter value.
isCompatible :: Separators
             -> [ParameterPattern]
             -> [(String, Maybe String)]
             -> CandidateFile
             -> Bool
isCompatible :: String
-> [ParameterPattern]
-> [(String, Maybe String)]
-> CandidateFile
-> Bool
isCompatible String
seps [ParameterPattern]
params [(String, Maybe String)]
pvals CandidateFile
fname =
  let splitFName :: String -> [String]
splitFName String
n = let (String
p,String
r) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
seps) String
n
                     in String
p forall a. a -> [a] -> [a]
: if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r then [] else String -> [String]
splitFName (forall a. [a] -> [a]
tail String
r)
      parts :: [String]
parts = let n' :: [String]
n' = String -> [String]
splitFName forall a b. (a -> b) -> a -> b
$ CandidateFile -> String
candidateFile CandidateFile
fname
              in CandidateFile -> [String]
candidateSubdirs CandidateFile
fname forall a. Semigroup a => a -> a -> a
<> [String]
n'
      noConflict :: t String -> (String, Maybe (t String)) -> Bool
noConflict t String
_ (String
_,Maybe (t String)
Nothing) = Bool
True
      noConflict t String
ps (String
pn,Just t String
vs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}.
Foldable t =>
String -> t String -> String -> Bool
isConflict String
pn t String
vs) t String
ps
      isConflict :: String -> t String -> String -> Bool
isConflict String
pn t String
vs String
p = forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ String
p forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t String
vs
                               , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. a -> Maybe a
Just String
p forall a. Eq a => a -> a -> Bool
/=) forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
pn [(String, Maybe String)]
pvals
                               ]
  in forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall {t :: * -> *} {t :: * -> *}.
(Foldable t, Foldable t) =>
t String -> (String, Maybe (t String)) -> Bool
noConflict [String]
parts) [ParameterPattern]
params