-- | 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 :: FilePath
         -> Separators
         -> [NamedParamMatch]
         -> [ (String, FileSuffix) ]
         -> [FilePath]
         -> Logic [(String, FilePath)]
getAssoc :: FilePath
-> FilePath
-> [NamedParamMatch]
-> [(FilePath, FilePath)]
-> [FilePath]
-> Logic [(FilePath, FilePath)]
getAssoc FilePath
rootPrefix FilePath
seps [NamedParamMatch]
pmatch [(FilePath, FilePath)]
assocNames [FilePath]
allNames = Logic [(FilePath, FilePath)]
assocSet
  where
    assocSet :: Logic [(FilePath, FilePath)]
assocSet = [Maybe (FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (FilePath, FilePath)] -> [(FilePath, FilePath)])
-> LogicT Identity [Maybe (FilePath, FilePath)]
-> Logic [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((FilePath, FilePath)
 -> LogicT Identity (Maybe (FilePath, FilePath)))
-> [(FilePath, FilePath)]
-> LogicT Identity [Maybe (FilePath, FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (FilePath, FilePath)
-> LogicT Identity (Maybe (FilePath, FilePath))
forall a. (a, FilePath) -> LogicT Identity (Maybe (a, FilePath))
fndAnAssoc [(FilePath, FilePath)]
assocNames

    fndAnAssoc :: (a, FilePath) -> LogicT Identity (Maybe (a, FilePath))
fndAnAssoc (a, FilePath)
assoc = LogicT Identity (a, FilePath)
-> ((a, FilePath) -> LogicT Identity (Maybe (a, FilePath)))
-> LogicT Identity (Maybe (a, FilePath))
-> LogicT Identity (Maybe (a, FilePath))
forall (m :: * -> *) a b.
MonadLogic m =>
m a -> (a -> m b) -> m b -> m b
ifte ((a, FilePath) -> LogicT Identity (a, FilePath)
forall a. (a, FilePath) -> LogicT Identity (a, FilePath)
fndAssoc (a, FilePath)
assoc)
                       (Maybe (a, FilePath) -> LogicT Identity (Maybe (a, FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (a, FilePath) -> LogicT Identity (Maybe (a, FilePath)))
-> ((a, FilePath) -> Maybe (a, FilePath))
-> (a, FilePath)
-> LogicT Identity (Maybe (a, FilePath))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a, FilePath) -> Maybe (a, FilePath)
forall a. a -> Maybe a
Just)
                       (Maybe (a, FilePath) -> LogicT Identity (Maybe (a, FilePath))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (a, FilePath)
forall a. Maybe a
Nothing)

    fndAssoc :: (a, FilePath) -> LogicT Identity (a, FilePath)
fndAssoc (a, FilePath)
assoc =
      do [NamedParamMatch]
pseq <- [NamedParamMatch] -> Logic [NamedParamMatch]
forall a. [a] -> Logic [a]
npseq [NamedParamMatch]
pmatch
         (FilePath
assocPfx, FilePath
assocSfx) <- FilePath -> [ParamMatch] -> Logic (FilePath, FilePath)
sepParams FilePath
seps ((NamedParamMatch -> ParamMatch)
-> [NamedParamMatch] -> [ParamMatch]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedParamMatch -> ParamMatch
forall a b. (a, b) -> b
snd [NamedParamMatch]
pseq)
         if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
assocSfx
           then do let assocNm :: FilePath
assocNm = if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((a, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (a, FilePath)
assoc) Bool -> Bool -> Bool
&&
                                    FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
assocPfx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 -- just a separator
                                 then FilePath
rootPrefix
                                 else FilePath
rootPrefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
assocPfx FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> ((a, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (a, FilePath)
assoc)
                   Bool -> LogicT Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (FilePath
assocNm FilePath -> [FilePath] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
allNames)
                   (a, FilePath) -> LogicT Identity (a, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, FilePath) -> a
forall a b. (a, b) -> a
fst (a, FilePath)
assoc, FilePath
assocNm)
           else let assocStart :: FilePath
assocStart = FilePath
rootPrefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
assocPfx
                    assocEnd :: FilePath
assocEnd = FilePath
assocSfx FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> (a, FilePath) -> FilePath
forall a b. (a, b) -> b
snd (a, FilePath)
assoc
                    aSL :: Int
aSL = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
assocStart
                    aEL :: Int
aEL = FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
assocEnd
                    possible :: FilePath -> Bool
possible FilePath
f =
                      [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ FilePath
assocStart FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf` FilePath
f
                          , FilePath
assocEnd FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isSuffixOf` FilePath
f
                          , FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> (Int
aSL Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
aEL)
                          , let mid :: FilePath
mid = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
aSL (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take (FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
f Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
aEL) FilePath
f)
                            in [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and ([Bool] -> Bool) -> [Bool] -> Bool
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> FilePath -> Bool) -> FilePath -> Char -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem FilePath
mid) FilePath
seps
                          ]
                    fnd :: [FilePath]
fnd = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
possible [FilePath]
allNames
                in do FilePath
f <- [FilePath] -> Logic FilePath
forall a. [a] -> Logic a
eachFrom [FilePath]
fnd
                      (a, FilePath) -> LogicT Identity (a, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ((a, FilePath) -> a
forall a b. (a, b) -> a
fst (a, FilePath)
assoc, FilePath
f)

    sepParams :: Separators -> [ParamMatch] -> Logic (String, String)
    sepParams :: FilePath -> [ParamMatch] -> Logic (FilePath, FilePath)
sepParams FilePath
sl = \case
      [] -> if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
sl
            then (FilePath, FilePath) -> Logic (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
            else do Char
s <- FilePath -> Logic Char
forall a. [a] -> Logic a
eachFrom FilePath
sl
                    (FilePath, FilePath) -> Logic (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char
s], [])
      (ParamMatch
NotSpecified:[ParamMatch]
ps) -> do (FilePath, FilePath)
r <- FilePath -> [ParamMatch] -> Logic (FilePath, FilePath)
sepParams FilePath
sl [ParamMatch]
ps
                              (FilePath, FilePath) -> Logic (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst (FilePath, FilePath)
r)
      ((Explicit FilePath
v):[ParamMatch]
ps) -> do (FilePath
l,FilePath
r) <- FilePath -> [ParamMatch] -> Logic (FilePath, FilePath)
sepParams FilePath
sl [ParamMatch]
ps
                              if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
sl
                                then (FilePath, FilePath) -> Logic (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
v FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
l, FilePath
r)
                                else do Char
s <- FilePath -> Logic Char
forall a. [a] -> Logic a
eachFrom FilePath
sl
                                        (FilePath, FilePath) -> Logic (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char
s] FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
v FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
l, FilePath
r)
      ((Assumed  FilePath
v):[ParamMatch]
ps) -> do (FilePath
l,FilePath
r) <- FilePath -> [ParamMatch] -> Logic (FilePath, FilePath)
sepParams FilePath
sl [ParamMatch]
ps
                              if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
sl
                                then (FilePath, FilePath) -> Logic (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
v FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
l, FilePath
r)
                                else do Char
s <- FilePath -> Logic Char
forall a. [a] -> Logic a
eachFrom FilePath
sl
                                        (FilePath, FilePath) -> Logic (FilePath, FilePath)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char
s] FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
v FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
l, FilePath
r)

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