-- | Function and associated helpers to determine the matching root
-- name.  The root name may contain zero or more parameter values.

{-# LANGUAGE LambdaCase #-}

module Test.Tasty.Sugar.RootCheck
  (
    rootMatch
  )
  where

import           Control.Monad
import           Control.Monad.Logic
import qualified Data.List as L
import           Data.Maybe ( catMaybes, isNothing )

import           Test.Tasty.Sugar.ParamCheck
import           Test.Tasty.Sugar.Types


-- | Determine which parts of the input name form the basePrefix and any
-- parameter values for searching for related files (expected and associated).
-- Parameter values are taken from subdirectory paths or filename elements (in
-- that order).
rootMatch :: CandidateFile -> Separators -> [ParameterPattern] -> String
          -> Logic ([NamedParamMatch], CandidateFile, String)
rootMatch :: CandidateFile
-> Separators
-> [ParameterPattern]
-> Separators
-> Logic ([NamedParamMatch], CandidateFile, Separators)
rootMatch CandidateFile
origRoot Separators
seps [ParameterPattern]
params Separators
rootCmp = do
  ([NamedParamMatch]
dmatch, [ParameterPattern]
drem) <- CandidateFile
-> [ParameterPattern]
-> [ParameterPattern]
-> Logic ([NamedParamMatch], [ParameterPattern])
dirMatches CandidateFile
origRoot [ParameterPattern]
params [ParameterPattern]
params
  ([NamedParamMatch]
rpm, CandidateFile
p, Separators
s) <- forall (m :: * -> *) a b.
MonadLogic m =>
m a -> (a -> m b) -> m b -> m b
ifte
                 (CandidateFile
-> Separators
-> [ParameterPattern]
-> Separators
-> Logic ([NamedParamMatch], CandidateFile, Separators)
rootParamMatch CandidateFile
origRoot Separators
seps [ParameterPattern]
drem Separators
rootCmp)
                 forall (m :: * -> *) a. Monad m => a -> m a
return
                 (CandidateFile
-> Separators
-> Logic ([NamedParamMatch], CandidateFile, Separators)
noRootParamMatch CandidateFile
origRoot Separators
seps)
  forall (m :: * -> *) a. Monad m => a -> m a
return ([NamedParamMatch]
dmatch forall a. Semigroup a => a -> a -> a
<> [NamedParamMatch]
rpm, CandidateFile
p, Separators
s)


data RootPart = RootSep String
              | RootParNm String String
              | RootText String
              | RootSuffix String
              deriving Int -> RootPart -> ShowS
[RootPart] -> ShowS
RootPart -> Separators
forall a.
(Int -> a -> ShowS)
-> (a -> Separators) -> ([a] -> ShowS) -> Show a
showList :: [RootPart] -> ShowS
$cshowList :: [RootPart] -> ShowS
show :: RootPart -> Separators
$cshow :: RootPart -> Separators
showsPrec :: Int -> RootPart -> ShowS
$cshowsPrec :: Int -> RootPart -> ShowS
Show

isRootParNm :: RootPart -> Bool
isRootParNm :: RootPart -> Bool
isRootParNm (RootParNm Separators
_ Separators
_) = Bool
True
isRootParNm RootPart
_ = Bool
False

isRootSep :: RootPart -> Bool
isRootSep :: RootPart -> Bool
isRootSep (RootSep Separators
_) = Bool
True
isRootSep RootPart
_ = Bool
False

rpStr :: [RootPart] -> String
rpStr :: [RootPart] -> Separators
rpStr = let s :: RootPart -> Separators
s = \case
              RootSep Separators
x -> Separators
x
              RootParNm Separators
_ Separators
x -> Separators
x
              RootText Separators
x -> Separators
x
              RootSuffix Separators
x -> Separators
x
            bld :: RootPart -> ShowS
bld RootPart
b Separators
a = Separators
a forall a. Semigroup a => a -> a -> a
<> RootPart -> Separators
s RootPart
b
        in forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RootPart -> ShowS
bld Separators
""

rpNPM :: [RootPart] -> [NamedParamMatch]
rpNPM :: [RootPart] -> [NamedParamMatch]
rpNPM = let bld :: RootPart -> Maybe [NamedParamMatch]
bld (RootParNm Separators
n Separators
v) = forall a. a -> Maybe a
Just [(Separators
n, Separators -> ParamMatch
Explicit Separators
v)]
            bld (RootSep Separators
_) = forall a. Maybe a
Nothing
            bld RootPart
p = forall a. HasCallStack => Separators -> a
error (Separators
"Invalid RootPart for NamedParamMatch: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Separators
show RootPart
p)
        in forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RootPart -> Maybe [NamedParamMatch]
bld


-- Return the prefix and suffix of the root name along with the
-- explicit parameter matches that comprise the central portion.
rootParamMatch :: CandidateFile
               -> Separators -> [ParameterPattern] -> String
               -> Logic ([NamedParamMatch], CandidateFile, String)
rootParamMatch :: CandidateFile
-> Separators
-> [ParameterPattern]
-> Separators
-> Logic ([NamedParamMatch], CandidateFile, Separators)
rootParamMatch CandidateFile
origRoot Separators
seps [ParameterPattern]
params Separators
rootCmp =
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Separators
seps
  then CandidateFile
-> Separators
-> [ParameterPattern]
-> Logic ([NamedParamMatch], CandidateFile, Separators)
rootParamMatchNoSeps CandidateFile
origRoot Separators
seps [ParameterPattern]
params
  else CandidateFile
-> Separators
-> [ParameterPattern]
-> Separators
-> Logic ([NamedParamMatch], CandidateFile, Separators)
rootParamFileMatches CandidateFile
origRoot Separators
seps [ParameterPattern]
params Separators
rootCmp


rootParamFileMatches :: CandidateFile
                     -> Separators -> [ParameterPattern] -> String
                     -> Logic ([NamedParamMatch], CandidateFile, String)
rootParamFileMatches :: CandidateFile
-> Separators
-> [ParameterPattern]
-> Separators
-> Logic ([NamedParamMatch], CandidateFile, Separators)
rootParamFileMatches CandidateFile
rootF Separators
seps [ParameterPattern]
parms Separators
rMatch = do
  let rnSplit :: [Separators]
rnSplit = Separators -> [Separators]
sepSplit forall a b. (a -> b) -> a -> b
$ CandidateFile -> Separators
candidateFile CandidateFile
rootF
      sepSplit :: Separators -> [Separators]
sepSplit = forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy Char -> Char -> Bool
sepPoint
      sepPoint :: Char -> Char -> Bool
sepPoint Char
a Char
b = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Char
a forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Separators
seps, Char
b forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Separators
seps ]
      rnPartIndices :: [Int]
rnPartIndices = [ Int
n | Int
n <- [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [RootPart]
rnParts forall a. Num a => a -> a -> a
- Int
1] , forall a. Integral a => a -> Bool
even Int
n ]
      freeValueParm :: Maybe ParameterPattern
freeValueParm = 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]
parms

      txtRootSfx :: [Separators]
txtRootSfx = Separators -> [Separators]
sepSplit forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
                   -- Find the concrete extension in the
                   -- rootName. Somewhat crude, but basically stops at
                   -- any character that could be part of a filemanip
                   -- GlobPattern.
                   forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem Separators
"[*]\\(|)") forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse Separators
rMatch

      -- if a part of the root filename matches a known parameter value, that is
      -- the only way that part can be interpreted, and that anchors it.

      rnParts :: [RootPart]
      rnParts :: [RootPart]
rnParts =
        let assignPart :: (Separators, Int) -> RootPart
assignPart (Separators
ptxt,Int
pidx) =
              let matchesParmValue :: (a, Maybe (t Separators)) -> Bool
matchesParmValue (a
_, Maybe (t Separators)
Nothing) = Bool
False
                  matchesParmValue (a
_, Just t Separators
vl) = Separators
ptxt forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t Separators
vl
              in if Int
pidx forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int]
rnPartIndices
                 then
                   if forall (t :: * -> *) a. Foldable t => t a -> Int
length [Separators]
rnSplit forall a. Num a => a -> a -> a
- Int
pidx forall a. Ord a => a -> a -> Bool
< forall (t :: * -> *) a. Foldable t => t a -> Int
length [Separators]
txtRootSfx
                   then Separators -> RootPart
RootSuffix Separators
ptxt
                   else case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find forall {t :: * -> *} {a}.
Foldable t =>
(a, Maybe (t Separators)) -> Bool
matchesParmValue [ParameterPattern]
parms of
                          Just (Separators
pn,Maybe [Separators]
_) -> Separators -> Separators -> RootPart
RootParNm Separators
pn Separators
ptxt
                          Maybe ParameterPattern
Nothing -> Separators -> RootPart
RootText Separators
ptxt
                 else Separators -> RootPart
RootSep Separators
ptxt
        in forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Separators, Int) -> RootPart
assignPart forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Separators]
rnSplit [Int
0..]

  -- want [prefix, sep, MATCHES, [suffix]]
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Separators]
rnSplit forall a. Ord a => a -> a -> Bool
> Int
2 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Separators]
txtRootSfx)

  let hasDupParNm :: Bool
hasDupParNm =
        let getParNm :: RootPart -> Maybe Separators
getParNm = \case
              RootParNm Separators
pn Separators
_ -> forall a. a -> Maybe a
Just Separators
pn
              RootPart
_ -> forall a. Maybe a
Nothing
            parNms :: [Separators]
parNms = forall a. [Maybe a] -> [a]
catMaybes (RootPart -> Maybe Separators
getParNm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RootPart]
rnParts)
        in Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Separators]
parNms forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => [a] -> [a]
L.nub [Separators]
parNms)

  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not Bool
hasDupParNm)

  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ RootPart -> Bool
isRootParNm forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [RootPart]
rnParts) -- must have a prefix

  let rnChunks :: Maybe
  (Either
     ([RootPart], [RootPart], [RootPart])
     ([RootPart], [RootPart], [RootPart], [RootPart], [RootPart]))
rnChunks =
        --  pfx parms1 mid parms2 sfx
        --      r1-------------------
        --             r2------------
        --                 r3--------
        let ([RootPart]
pfx,[RootPart]
r1)     = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootPart -> Bool
isRootParNm) [RootPart]
rnParts
            ([RootPart]
parms1,[RootPart]
r2)  = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span RootPart -> Bool
paramPart [RootPart]
r1
            ([RootPart]
mid,[RootPart]
r3)     = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootPart -> Bool
isRootParNm) [RootPart]
r2
            ([RootPart]
parms2,[RootPart]
sfx) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span RootPart -> Bool
paramPart [RootPart]
r3
            ([RootPart]
_,[RootPart]
extraprm) = forall a. (a -> Bool) -> [a] -> ([a], [a])
L.span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. RootPart -> Bool
isRootParNm) [RootPart]
sfx
            paramPart :: RootPart -> Bool
paramPart RootPart
x = RootPart -> Bool
isRootParNm RootPart
x Bool -> Bool -> Bool
|| RootPart -> Bool
isRootSep RootPart
x
        in if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RootPart]
r3
           then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left ([RootPart]
pfx, [RootPart]
parms1, [RootPart]
mid)
           else if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RootPart]
extraprm
                then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ([RootPart]
pfx, [RootPart]
parms1, [RootPart]
mid, [RootPart]
parms2, [RootPart]
sfx)
                else forall a. Maybe a
Nothing

      freeFirst :: Maybe (Either ([RootPart], [RootPart], [RootPart]) b)
-> LogicT Identity ([NamedParamMatch], Separators, Separators)
freeFirst Maybe (Either ([RootPart], [RootPart], [RootPart]) b)
Nothing = forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeFirst (Just (Right b
_)) = forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeFirst (Just (Left ([RootPart]
allRP, [], []))) =
        -- There were no parameter value matches.  If there is
        -- a wildcard parameter, try it in all the possible
        -- positions.
        if forall (t :: * -> *) a. Foldable t => t a -> Int
length [RootPart]
allRP forall a. Ord a => a -> a -> Bool
< Int
3
        then forall (m :: * -> *) a. MonadPlus m => m a
mzero
        else case Maybe ParameterPattern
freeValueParm of
               Maybe ParameterPattern
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
               Just ParameterPattern
p ->
                 do Int
idx <- forall a. [a] -> Logic a
eachFrom [Int
i | Int
i <- [Int
2..forall (t :: * -> *) a. Foldable t => t a -> Int
length [RootPart]
allRP], forall a. Integral a => a -> Bool
even Int
i]
                    case forall a. Int -> [a] -> [a]
drop Int
idx [RootPart]
allRP of
                      (RootText Separators
idxv:[RootPart]
_) -> do
                        let free :: RootPart
free = Separators -> Separators -> RootPart
RootParNm (forall a b. (a, b) -> a
fst ParameterPattern
p) Separators
idxv
                            start :: [RootPart]
start = forall a. Int -> [a] -> [a]
take (Int
idx forall a. Num a => a -> a -> a
- Int
1) [RootPart]
allRP
                        forall (m :: * -> *) a. Monad m => a -> m a
return ( [RootPart] -> [NamedParamMatch]
rpNPM [RootPart
free]
                               , [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ [RootPart]
start
                               , [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop (Int
idx forall a. Num a => a -> a -> a
+ Int
2) [RootPart]
allRP )
                      [RootPart]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeFirst (Just (Left ([RootPart]
pfx, [RootPart]
pl1, [RootPart]
sfx))) =
        case Maybe ParameterPattern
freeValueParm of
          Maybe ParameterPattern
Nothing ->
            -- No wildcard param, so just try the observed
            -- pattern
            forall (m :: * -> *) a. Monad m => a -> m a
return ( [RootPart] -> [NamedParamMatch]
rpNPM [RootPart]
pl1, [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [RootPart]
pfx, [RootPart] -> Separators
rpStr [RootPart]
sfx )
          Just ParameterPattern
p ->
            if forall (t :: * -> *) a. Foldable t => t a -> Int
length [RootPart]
pfx forall a. Ord a => a -> a -> Bool
< Int
3
            then
              -- not enough elements of pfx to support a wildcard, so there must
              -- be no expression of the wildcard and just the observed pattern.
              -- Also remove any separator from the prefix.
              forall (m :: * -> *) a. Monad m => a -> m a
return ( [RootPart] -> [NamedParamMatch]
rpNPM [RootPart]
pl1, [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take Int
1 [RootPart]
pfx, [RootPart] -> Separators
rpStr [RootPart]
sfx )
            else
              -- There is a wildcard parameter, try it at the end
              -- of pfx and before pl1
              case forall a. [a] -> [a]
reverse [RootPart]
pfx of
                (RootPart
_:RootText Separators
lpv:[RootPart]
_) ->
                  forall (m :: * -> *) a. Monad m => a -> m a
return ( [RootPart] -> [NamedParamMatch]
rpNPM forall a b. (a -> b) -> a -> b
$ Separators -> Separators -> RootPart
RootParNm (forall a b. (a, b) -> a
fst ParameterPattern
p) Separators
lpv forall a. a -> [a] -> [a]
: [RootPart]
pl1
                         , [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
3 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [RootPart]
pfx
                         , [RootPart] -> Separators
rpStr [RootPart]
sfx )
                [RootPart]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

      freeLast :: Maybe (Either ([RootPart], [RootPart], [RootPart]) b)
-> m ([NamedParamMatch], Separators, Separators)
freeLast Maybe (Either ([RootPart], [RootPart], [RootPart]) b)
Nothing = forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeLast (Just (Right b
_)) = forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeLast (Just (Left ([RootPart]
_, [], []))) = forall (m :: * -> *) a. MonadPlus m => m a
mzero -- handled by freeFirst
      freeLast (Just (Left ([RootPart]
_, [RootPart]
_, []))) = forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeLast (Just (Left ([RootPart]
pfx, [RootPart]
parms1, [RootPart]
sfx))) =
        case Maybe ParameterPattern
freeValueParm of
          Maybe ParameterPattern
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero  -- handled by freeFirst
          Just ParameterPattern
p ->
            -- There is a wildcard parameter, try it at the end
            -- of pfx and before pl1
            case [RootPart]
sfx of
              (RootText Separators
fsv:[RootPart]
_) ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ( [RootPart] -> [NamedParamMatch]
rpNPM forall a b. (a -> b) -> a -> b
$ [RootPart]
parms1 forall a. Semigroup a => a -> a -> a
<> [Separators -> Separators -> RootPart
RootParNm (forall a b. (a, b) -> a
fst ParameterPattern
p) Separators
fsv]
                       , [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [RootPart]
pfx
                       , [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
tail [RootPart]
sfx )
              [RootPart]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

      freeMid :: Maybe
  (Either
     a ([RootPart], [RootPart], [RootPart], [RootPart], [RootPart]))
-> m ([NamedParamMatch], Separators, Separators)
freeMid Maybe
  (Either
     a ([RootPart], [RootPart], [RootPart], [RootPart], [RootPart]))
Nothing = forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeMid (Just (Left a
_)) = forall (m :: * -> *) a. MonadPlus m => m a
mzero
      freeMid (Just (Right ([RootPart]
pfx, [RootPart]
parms1, [RootPart]
mid, [RootPart]
parms2, [RootPart]
sfx))) =
        -- If there is a wildcard param and mid is a single
        -- element, then try converting the mid to the
        -- wildcard, otherwise this is an invalid name.
        if forall (t :: * -> *) a. Foldable t => t a -> Int
length [RootPart]
mid forall a. Eq a => a -> a -> Bool
/= Int
3
        then forall (m :: * -> *) a. MonadPlus m => m a
mzero
        else case Maybe ParameterPattern
freeValueParm of
               Maybe ParameterPattern
Nothing -> forall (m :: * -> *) a. MonadPlus m => m a
mzero
               Just ParameterPattern
p ->
                 case [RootPart]
mid of
                   (RootPart
ms1:RootText Separators
mv:RootPart
ms2:[]) ->
                     forall (m :: * -> *) a. Monad m => a -> m a
return ( [RootPart] -> [NamedParamMatch]
rpNPM ( [RootPart]
parms1 forall a. Semigroup a => a -> a -> a
<> [Separators -> Separators -> RootPart
RootParNm (forall a b. (a, b) -> a
fst ParameterPattern
p) Separators
mv] forall a. Semigroup a => a -> a -> a
<>
                                      [RootPart]
parms2 )
                            , [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ [RootPart]
pfx forall a. Semigroup a => a -> a -> a
<> [RootPart
ms1]
                            , [RootPart] -> Separators
rpStr forall a b. (a -> b) -> a -> b
$ RootPart
ms2 forall a. a -> [a] -> [a]
: [RootPart]
sfx )
                   [RootPart]
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

  (\([NamedParamMatch]
a,Separators
fn,Separators
b) -> ([NamedParamMatch]
a, CandidateFile
rootF { candidateFile :: Separators
candidateFile = Separators
fn }, Separators
b))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((forall {b}.
Maybe (Either ([RootPart], [RootPart], [RootPart]) b)
-> LogicT Identity ([NamedParamMatch], Separators, Separators)
freeFirst Maybe
  (Either
     ([RootPart], [RootPart], [RootPart])
     ([RootPart], [RootPart], [RootPart], [RootPart], [RootPart]))
rnChunks)
         forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (forall {m :: * -> *} {b}.
MonadPlus m =>
Maybe (Either ([RootPart], [RootPart], [RootPart]) b)
-> m ([NamedParamMatch], Separators, Separators)
freeLast Maybe
  (Either
     ([RootPart], [RootPart], [RootPart])
     ([RootPart], [RootPart], [RootPart], [RootPart], [RootPart]))
rnChunks)
         forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` (forall {m :: * -> *} {a}.
MonadPlus m =>
Maybe
  (Either
     a ([RootPart], [RootPart], [RootPart], [RootPart], [RootPart]))
-> m ([NamedParamMatch], Separators, Separators)
freeMid Maybe
  (Either
     ([RootPart], [RootPart], [RootPart])
     ([RootPart], [RootPart], [RootPart], [RootPart], [RootPart]))
rnChunks))


-- If no separators, there are no "rnParts" identifiable, so fall
-- back on a cruder algorithm that simply attempts to find a
-- sequence of paramvals in the middle of the string and extract
-- the prefix and suffix (if any) around those paramvals.
rootParamMatchNoSeps :: CandidateFile -> Separators -> [ParameterPattern]
                     -> Logic ([NamedParamMatch], CandidateFile, String)
rootParamMatchNoSeps :: CandidateFile
-> Separators
-> [ParameterPattern]
-> Logic ([NamedParamMatch], CandidateFile, Separators)
rootParamMatchNoSeps CandidateFile
rootF Separators
seps' [ParameterPattern]
parms = do
  [ParameterPattern]
pseq <- forall a. [a] -> Logic a
eachFrom forall a b. (a -> b) -> a -> b
$ 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 => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]]
L.permutations [ParameterPattern]
parms
  [(Separators, Maybe Separators)]
pvals <- [ParameterPattern] -> Logic [(Separators, Maybe Separators)]
getPVals [ParameterPattern]
pseq
  ([NamedParamMatch]
pvset, Int
_pvcnt, Separators
pvstr) <- Separators
-> [NamedParamMatch]
-> [(Separators, Maybe Separators)]
-> Logic ([NamedParamMatch], Int, Separators)
pvalMatch Separators
seps' [] [(Separators, Maybe Separators)]
pvals
  -- _pvcnt can be ignored because each is a different root
  let explicit :: [NamedParamMatch]
explicit = 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) [NamedParamMatch]
pvset
  let rootNm :: Separators
rootNm = CandidateFile -> Separators
candidateFile CandidateFile
rootF
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NamedParamMatch]
explicit
             , Separators
pvstr forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf` Separators
rootNm
             , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Separators
pvstr forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` Separators
rootNm
             ])
  let l1 :: Int
l1 = forall (t :: * -> *) a. Foldable t => t a -> Int
length Separators
rootNm
      l2 :: Int
l2 = forall (t :: * -> *) a. Foldable t => t a -> Int
length Separators
pvstr
      bslen :: Int
bslen = Int
l1 forall a. Num a => a -> a -> a
- Int
l2
      matches :: Int -> Bool
matches Int
n = Separators
pvstr forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` (forall a. Int -> [a] -> [a]
drop Int
n Separators
rootNm)
  case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find Int -> Bool
matches forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Int
1..Int
bslen] of
    Just Int
pfxlen ->
      let basefname :: Separators
basefname = forall a. Int -> [a] -> [a]
take Int
pfxlen Separators
rootNm
          basename :: CandidateFile
basename = CandidateFile
rootF { candidateFile :: Separators
candidateFile = Separators
basefname }
          suffix :: Separators
suffix = forall a. Int -> [a] -> [a]
drop (Int
pfxlen forall a. Num a => a -> a -> a
+ Int
l2) Separators
rootNm
      in forall (m :: * -> *) a. Monad m => a -> m a
return ([NamedParamMatch]
explicit, CandidateFile
basename, Separators
suffix)
    Maybe Int
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero

-- Return origRootName up to each sep-indicated point.
noRootParamMatch :: CandidateFile -> Separators
                 -> Logic ([NamedParamMatch], CandidateFile, String)
noRootParamMatch :: CandidateFile
-> Separators
-> Logic ([NamedParamMatch], CandidateFile, Separators)
noRootParamMatch CandidateFile
origRoot Separators
seps =
  forall (m :: * -> *) a. Monad m => a -> m a
return ([], CandidateFile
origRoot, Separators
"") forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus`
  do Char
s <- forall a. [a] -> Logic a
eachFrom Separators
seps
     let origRootName :: Separators
origRootName = CandidateFile -> Separators
candidateFile CandidateFile
origRoot
     Int
i <- forall a. [a] -> Logic a
eachFrom [Int
1..forall (t :: * -> *) a. Foldable t => t a -> Int
length Separators
origRootName forall a. Num a => a -> a -> a
- Int
1]
     let a :: CandidateFile
a = CandidateFile
origRoot { candidateFile :: Separators
candidateFile = forall a. Int -> [a] -> [a]
take Int
i Separators
origRootName }
     let b :: Separators
b = forall a. Int -> [a] -> [a]
drop Int
i Separators
origRootName
     if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Separators
b
       then do forall (m :: * -> *) a. Monad m => a -> m a
return ([], CandidateFile
a, Separators
"")
       else do forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null Separators
b, forall a. [a] -> a
head Separators
b forall a. Eq a => a -> a -> Bool
== Char
s ])
               forall (m :: * -> *) a. Monad m => a -> m a
return ([], CandidateFile
a, forall a. [a] -> [a]
tail Separators
b)