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

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

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

import           Control.Monad ( guard )
import           Data.Function ( on )
import qualified Data.List as DL

import           Test.Tasty.Sugar.Candidates
import           Test.Tasty.Sugar.Iterations
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]
         -> LogicI [(String, CandidateFile)]
getAssoc :: CandidateFile
-> String
-> [NamedParamMatch]
-> [(String, String)]
-> [CandidateFile]
-> LogicI [(String, CandidateFile)]
getAssoc CandidateFile
rootPrefix String
seps [NamedParamMatch]
pmatch [(String, String)]
assocNames [CandidateFile]
allNames = LogicI [(String, CandidateFile)]
assocSet
  where

    assocSet :: LogicI [(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) -> LogicI [(String, CandidateFile)]
fndBestAssoc [(String, String)]
assocNames

    fndBestAssoc :: (String, FileSuffix)
                 -> LogicI [(String, CandidateFile)] -- usually just one
    fndBestAssoc :: (String, String) -> LogicI [(String, CandidateFile)]
fndBestAssoc (String, String)
assoc = forall a. (a, IterStat) -> LogicI a
addSubLogicStats (forall a. LogicI a -> ([a], IterStat)
observeIT ((String, String) -> LogicI (String, CandidateFile)
fndAssoc (String, String)
assoc))

    fndAssoc :: (String, FileSuffix) -> LogicI (String, CandidateFile)
    fndAssoc :: (String, String) -> LogicI (String, CandidateFile)
fndAssoc (String, String)
assoc =
      -- First, eliminate any files that don't start with rootPrefix or end in
      -- this assoc suffix (do this before trying any backtracking).
      do let sfxMatch :: CandidateFile -> Bool
sfxMatch CandidateFile
cf =
               forall (t :: * -> *). Foldable t => t Bool -> Bool
and [ String -> CandidateFile -> CandidateFile -> Bool
candidateMatchPrefix String
seps CandidateFile
rootPrefix CandidateFile
cf
                   , String -> String -> CandidateFile -> CandidateFile -> Bool
candidateMatchSuffix String
seps (forall a b. (a, b) -> b
snd (String, String)
assoc) CandidateFile
rootPrefix CandidateFile
cf
                   ]
             assocNms :: [CandidateFile]
assocNms = forall a. [a] -> [a]
DL.reverse
                        forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
DL.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ([ParamMatch] -> Natural
matchStrength 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) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. CandidateFile -> [NamedParamMatch]
candidatePMatch))
                        forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter CandidateFile -> Bool
sfxMatch [CandidateFile]
allNames
         CandidateFile
afile <- forall a. Text -> [a] -> LogicI a
eachFrom Text
"assoc candidate" [CandidateFile]
assocNms
         forall (f :: * -> *). Alternative f => Bool -> f ()
guard ([(String, Maybe String)] -> CandidateFile -> Bool
isCompatible (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParamMatch -> Maybe String
getParamVal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [NamedParamMatch]
pmatch) CandidateFile
afile)
         forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a, b) -> a
fst (String, String)
assoc, CandidateFile
afile)