-- | Function and implementation to find association files for an
-- identified test root file.

{-# LANGUAGE LambdaCase #-}

module Test.Tasty.Sugar.AssocCheck
  (
    getAssoc
  )
  where

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

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


-- | For a specific NamedParamMatch, find all associated files having
-- the rootMatch plus the named parameter values (in the same order
-- but with any combination of separators) and the specified suffix
-- match.
getAssoc :: CandidateFile
         -> Separators
         -> [NamedParamMatch]
         -> [ (String, FileSuffix) ]
         -> [CandidateFile]
         -> Logic [(String, CandidateFile)]
getAssoc :: CandidateFile
-> String
-> [NamedParamMatch]
-> [(String, String)]
-> [CandidateFile]
-> Logic [(String, CandidateFile)]
getAssoc CandidateFile
rootPrefix String
seps [NamedParamMatch]
pmatch [(String, String)]
assocNames [CandidateFile]
allNames = Logic [(String, CandidateFile)]
assocSet
  where
    assocSet :: Logic [(String, CandidateFile)]
assocSet = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (String, String) -> Logic [(String, CandidateFile)]
fndBestAssoc [(String, String)]
assocNames

    fndBestAssoc :: (String, FileSuffix)
                 -> Logic [(String, CandidateFile)] -- usually just one
    fndBestAssoc :: (String, String) -> Logic [(String, CandidateFile)]
fndBestAssoc (String, String)
assoc =
      do let candidates :: [(Int, (String, CandidateFile))]
candidates = forall a. Eq a => [a] -> [a]
L.nub forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
                          forall a. Logic a -> [a]
observeAll ((String, String) -> Logic (Maybe (Int, (String, CandidateFile)))
fndAnAssoc (String, String)
assoc)
         let highestRank :: Int
highestRank = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, (String, CandidateFile))]
candidates)
             c :: [(Int, (String, CandidateFile))]
c = forall a. (a -> Bool) -> [a] -> [a]
filter ((forall a. Eq a => a -> a -> Bool
== Int
highestRank) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [(Int, (String, CandidateFile))]
candidates
         if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Int, (String, CandidateFile))]
candidates
           then forall (m :: * -> *) a. Monad m => a -> m a
return []
           else forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, (String, CandidateFile))]
c)

    fndAnAssoc :: (String, FileSuffix)
               -> Logic (Maybe (Int, (String, CandidateFile)))
    fndAnAssoc :: (String, String) -> Logic (Maybe (Int, (String, CandidateFile)))
fndAnAssoc (String, String)
assoc = forall (m :: * -> *) a b.
MonadLogic m =>
m a -> (a -> m b) -> m b -> m b
ifte ((String, String) -> Logic (Int, (String, CandidateFile))
fndAssoc (String, String)
assoc)
                       (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just)
                       (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)

    fndAssoc :: (String, FileSuffix) -> Logic (Int, (String, CandidateFile))
    fndAssoc :: (String, String) -> Logic (Int, (String, CandidateFile))
fndAssoc (String, String)
assoc =
      do [NamedParamMatch]
pseq <- forall {a}. [a] -> Logic [a]
npseq [NamedParamMatch]
pmatch
         (Int
rank, String
assocPfx, String
assocSfx) <- String -> [ParamMatch] -> Logic (Int, String, String)
sepParams String
seps (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [NamedParamMatch]
pseq)
         let possible :: String -> Bool
possible =
               if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
assocSfx
               then let justSep :: Bool
justSep = forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a b. (a, b) -> b
snd (String, String)
assoc) Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Int
length String
assocPfx forall a. Eq a => a -> a -> Bool
== Int
1
                        rootNm :: String
rootNm = CandidateFile -> String
candidateFile CandidateFile
rootPrefix
                        assocFName :: String
assocFName = if Bool
justSep
                                     then String
rootNm
                                     else String
rootNm forall a. Semigroup a => a -> a -> a
<> String
assocPfx forall a. Semigroup a => a -> a -> a
<> (forall a b. (a, b) -> b
snd (String, String)
assoc)
                    in (String
assocFName forall a. Eq a => a -> a -> Bool
==)
               else let assocStart :: String
assocStart = CandidateFile -> String
candidateFile CandidateFile
rootPrefix forall a. Semigroup a => a -> a -> a
<> String
assocPfx
                        assocEnd :: String
assocEnd = String
assocSfx forall a. Semigroup a => a -> a -> a
<> forall a b. (a, b) -> b
snd (String, String)
assoc
                        aSL :: Int
aSL = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
assocStart
                        aEL :: Int
aEL = forall (t :: * -> *) a. Foldable t => t a -> Int
length String
assocEnd
                        chk :: String -> Bool
chk String
f =
                          forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ String
assocStart forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` String
f
                              , String
assocEnd forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` String
f
                              , forall (t :: * -> *) a. Foldable t => t a -> Int
length String
f forall a. Ord a => a -> a -> Bool
> (Int
aSL forall a. Num a => a -> a -> a
+ Int
aEL)
                              , let mid :: String
mid = forall a. Int -> [a] -> [a]
drop Int
aSL (forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
f forall a. Num a => a -> a -> a
- Int
aEL) String
f)
                                in forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 String
mid) String
seps
                              ]
                    in String -> Bool
chk
         CandidateFile
f <- forall a. [a] -> Logic a
eachFrom forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String -> Bool
possible forall b c a. (b -> c) -> (a -> b) -> a -> c
. CandidateFile -> String
candidateFile) [CandidateFile]
allNames
         forall (m :: * -> *) a. Monad m => a -> m a
return (Int
rank, (forall a b. (a, b) -> a
fst (String, String)
assoc, CandidateFile
f))

    sepParams :: Separators -> [ParamMatch] -> Logic (Int, String, String)
    sepParams :: String -> [ParamMatch] -> Logic (Int, String, String)
sepParams String
sl =
      let rank :: (a, b, c) -> a
rank (a
n,b
_,c
_) = a
n
          pfx :: (a, b, c) -> b
pfx (a
_,b
l,c
_) = b
l
      in \case
        [] -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sl
              then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, [], [])
              else do Char
s <- forall a. [a] -> Logic a
eachFrom String
sl
                      forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, [Char
s], [])
        (ParamMatch
NotSpecified:[ParamMatch]
ps) -> do (Int, String, String)
r <- String -> [ParamMatch] -> Logic (Int, String, String)
sepParams String
sl [ParamMatch]
ps
                                forall (m :: * -> *) a. Monad m => a -> m a
return (forall {a} {b} {c}. (a, b, c) -> a
rank (Int, String, String)
r, [], forall {a} {b} {c}. (a, b, c) -> b
pfx (Int, String, String)
r)
        ((Explicit String
v):[ParamMatch]
ps) -> do (Int
n,String
l,String
r) <- String -> [ParamMatch] -> Logic (Int, String, String)
sepParams String
sl [ParamMatch]
ps
                                if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sl
                                  then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
nforall a. Num a => a -> a -> a
+Int
1, String
v forall a. Semigroup a => a -> a -> a
<> String
l, String
r)
                                  else do Char
s <- forall a. [a] -> Logic a
eachFrom String
sl
                                          forall (m :: * -> *) a. Monad m => a -> m a
return (Int
nforall a. Num a => a -> a -> a
+Int
1, [Char
s] forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
l, String
r)
        ((Assumed  String
v):[ParamMatch]
ps) -> do (Int
n,String
l,String
r) <- String -> [ParamMatch] -> Logic (Int, String, String)
sepParams String
sl [ParamMatch]
ps
                                if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
sl
                                  then forall (m :: * -> *) a. Monad m => a -> m a
return (Int
nforall a. Num a => a -> a -> a
+Int
1, String
v forall a. Semigroup a => a -> a -> a
<> String
l, String
r)
                                  else do Char
s <- forall a. [a] -> Logic a
eachFrom String
sl
                                          forall (m :: * -> *) a. Monad m => a -> m a
return (Int
nforall a. Num a => a -> a -> a
+Int
1, [Char
s] forall a. Semigroup a => a -> a -> a
<> String
v forall a. Semigroup a => a -> a -> a
<> String
l, String
r)

    npseq :: [a] -> Logic [a]
npseq = forall a. [a] -> Logic a
eachFrom
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([]forall a. a -> [a] -> [a]
:)                -- consider no parameters just once
            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 (t :: * -> *) a. Foldable t => t a -> Bool
null)  -- excluding multiple blanks in
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a. [a] -> [[a]]
L.inits    -- any number of the
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
L.permutations       -- parameters in each possible order