{-# LANGUAGE CPP #-}

-- | Automatic test discovery and runner for the tasty framework.
module Test.Tasty.Discover.Internal.Driver
  ( -- * Main Test Generator
    generateTestDriver

    -- * For Testing Purposes Only
  , ModuleTree (..)
  , findTests
  , mkModuleTree
  , showTests
  , extractTests
  ) where

import Control.Monad                          (filterM)
import Data.List                              (dropWhileEnd, intercalate, isPrefixOf, nub, sort, stripPrefix)
import Data.Maybe                             (fromMaybe)
import System.Directory                       (doesFileExist)
import System.FilePath                        (pathSeparator)
import System.FilePath.Glob                   (compile, globDir1, match)
import System.IO                              (IOMode (ReadMode), withFile)
import Test.Tasty.Discover.Internal.Config    (Config (..), GlobPattern)
import Test.Tasty.Discover.Internal.Generator (Generator (..), Test (..), generators, getGenerators, mkTest, showSetup)

import qualified Data.Map.Strict as M

#if defined(mingw32_HOST_OS)
import GHC.IO.Encoding.CodePage (mkLocaleEncoding)
import GHC.IO.Encoding.Failure  (CodingFailureMode (TransliterateCodingFailure))
import GHC.IO.Handle            (hGetContents, hSetEncoding)
#else
import GHC.IO.Handle (hGetContents)
#endif

-- | Main function generator, along with all the boilerplate which
-- which will run the discovered tests.
generateTestDriver :: Config -> String -> [String] -> FilePath -> [Test] -> String
generateTestDriver :: Config -> [Char] -> [[Char]] -> [Char] -> [Test] -> [Char]
generateTestDriver Config
config [Char]
modname [[Char]]
is [Char]
src [Test]
tests =
  let generators' :: [Generator]
generators' = [Test] -> [Generator]
getGenerators [Test]
tests
      testNumVars :: [[Char]]
testNumVars = (Int -> [Char]) -> [Int] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (([Char]
"t"[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> (Int -> [Char]) -> Int -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Char]
forall a. Show a => a -> [Char]
show) [(Int
0 :: Int)..]
      testKindImports :: [[[Char]]]
testKindImports = (Generator -> [[Char]]) -> [Generator] -> [[[Char]]]
forall a b. (a -> b) -> [a] -> [b]
map Generator -> [[Char]]
generatorImports [Generator]
generators' :: [[String]]
      testImports :: [[Char]]
testImports = [[Char]] -> [[Char]]
showImports (([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
ingredientImport [[Char]]
is [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ (Test -> [Char]) -> [Test] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Test -> [Char]
testModule [Test]
tests) :: [String]
      exports :: [Char]
exports = if Config -> Bool
noMain Config
config
                then [Char]
"(ingredients, tests)"
                else [Char]
"(main, ingredients, tests)"
      mainFunction :: [Char]
mainFunction = if Config -> Bool
noMain Config
config
                     then [Char]
""
                     else [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [Char]
"main :: IO ()\n"
                                 , [Char]
"main = do\n"
                                 , [Char]
"  args <- E.getArgs\n"
                                 , [Char]
"  E.withArgs (" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall a. Show a => a -> [Char]
show (Config -> [[Char]]
tastyOptions Config
config) [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ++ args) $"
                                 , [Char]
"    tests >>= T.defaultMainWithIngredients ingredients\n"
                                 ]
      -- Only include System.Environment import when main function is generated
      envImport :: [[Char]]
envImport = if Config -> Bool
noMain Config
config then [] else [[Char]
"import qualified System.Environment as E"]
      baseImports :: [[Char]]
baseImports = [ [Char]
"import Prelude"
                    , [Char]
"import qualified Test.Tasty as T"
                    , [Char]
"import qualified Test.Tasty.Ingredients as T"
                    ] [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
envImport
  in [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    [ [Char]
"{-# LANGUAGE FlexibleInstances #-}\n"
    , [Char]
"\n"
    , [Char]
"module " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
modname [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
exports [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" where\n"
    , [Char]
"\n"
    , [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
forall a. Monoid a => [a] -> a
mconcat ([[Char]]
baseImports[[Char]] -> [[[Char]]] -> [[[Char]]]
forall a. a -> [a] -> [a]
:[[[Char]]]
testKindImports) [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
testImports
    , [Char]
"\n"
    , [Char]
"{- HLINT ignore \"Evaluate\" -}\n"
    , [Char]
"{- HLINT ignore \"Use let\" -}\n"
    , [Char]
"\n"
    , [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Generator -> [Char]) -> [Generator] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Generator -> [Char]
generatorClass [Generator]
generators'
    , [Char]
"tests :: IO T.TestTree\n"
    , [Char]
"tests = do\n"
    , [[Char]] -> [Char]
unlines ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Test -> [Char] -> [Char]) -> [Test] -> [[Char]] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Test -> [Char] -> [Char]
showSetup [Test]
tests [[Char]]
testNumVars
    , [Char]
"  pure $ T.testGroup " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> [Char]
forall a. Show a => a -> [Char]
show [Char]
src [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" ["
    , [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ Config -> [Test] -> [[Char]] -> [[Char]]
showTests Config
config [Test]
tests [[Char]]
testNumVars
    , [Char]
"]\n"
    , [Char]
"ingredients :: [T.Ingredient]\n"
    , [Char]
"ingredients = " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
ingredients [[Char]]
is [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
    , [Char]
mainFunction
    ]

-- | Match files by specified glob pattern.
filesByModuleGlob :: FilePath -> Maybe GlobPattern -> IO [String]
filesByModuleGlob :: [Char] -> Maybe [Char] -> IO [[Char]]
filesByModuleGlob [Char]
directory Maybe [Char]
globPattern = do
  [[Char]]
allPaths <- Pattern -> [Char] -> IO [[Char]]
globDir1 Pattern
pattern [Char]
directory
  -- Filter out directories to avoid "inappropriate type" errors
  ([Char] -> IO Bool) -> [[Char]] -> IO [[Char]]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM [Char] -> IO Bool
doesFileExist [[Char]]
allPaths
  where pattern :: Pattern
pattern = [Char] -> Pattern
compile ([Char]
"**/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"*.hs" Maybe [Char]
globPattern)

-- | Filter and remove files by specified glob pattern.
ignoreByModuleGlob :: [FilePath] -> Maybe GlobPattern -> [FilePath]
ignoreByModuleGlob :: [[Char]] -> Maybe [Char] -> [[Char]]
ignoreByModuleGlob [[Char]]
filePaths Maybe [Char]
Nothing = [[Char]]
filePaths
ignoreByModuleGlob [[Char]]
filePaths (Just [Char]
ignoreGlob) = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([Char] -> Bool) -> [Char] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pattern -> [Char] -> Bool
match Pattern
pattern) [[Char]]
filePaths
  where pattern :: Pattern
pattern = [Char] -> Pattern
compile ([Char]
"**/" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
ignoreGlob)

-- | Discover the tests modules.
findTests :: Config -> IO [Test]
findTests :: Config -> IO [Test]
findTests Config
config = do
  let directory :: [Char]
directory = Config -> [Char]
searchDir Config
config
  [[Char]]
allModules <- [Char] -> Maybe [Char] -> IO [[Char]]
filesByModuleGlob [Char]
directory (Config -> Maybe [Char]
modules Config
config)
  let filtered :: [[Char]]
filtered = [[Char]] -> Maybe [Char] -> [[Char]]
ignoreByModuleGlob [[Char]]
allModules (Config -> Maybe [Char]
ignores Config
config)
      -- The files to scan need to be sorted or otherwise the output of
      -- findTests might not be deterministic
      sortedFiltered :: [[Char]]
sortedFiltered = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort [[Char]]
filtered
  [[Test]] -> [Test]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Test]] -> [Test]) -> IO [[Test]] -> IO [Test]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Char] -> IO [Test]) -> [[Char]] -> IO [[Test]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ([Char] -> [Char] -> IO [Test]
extract [Char]
directory) [[Char]]
sortedFiltered
  where extract :: [Char] -> [Char] -> IO [Test]
extract [Char]
directory [Char]
filePath =
          [Char] -> IOMode -> (Handle -> IO [Test]) -> IO [Test]
forall r. [Char] -> IOMode -> (Handle -> IO r) -> IO r
withFile [Char]
filePath IOMode
ReadMode ((Handle -> IO [Test]) -> IO [Test])
-> (Handle -> IO [Test]) -> IO [Test]
forall a b. (a -> b) -> a -> b
$ \Handle
h -> do
#if defined(mingw32_HOST_OS)
          -- Avoid internal error: hGetContents: invalid argument (invalid byte sequence)' non UTF-8 Windows
            hSetEncoding h $ mkLocaleEncoding TransliterateCodingFailure
#endif
            [Test]
tests <- [Char] -> [Char] -> [Test]
extractTests ([Char] -> [Char] -> [Char]
dropDirectory [Char]
directory [Char]
filePath) ([Char] -> [Test]) -> IO [Char] -> IO [Test]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Handle -> IO [Char]
hGetContents Handle
h
            Int -> IO [Test] -> IO [Test]
forall a b. a -> b -> b
seq ([Test] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Test]
tests) ([Test] -> IO [Test]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Test]
tests)
        dropDirectory :: [Char] -> [Char] -> [Char]
dropDirectory [Char]
directory [Char]
filePath = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
filePath (Maybe [Char] -> [Char]) -> Maybe [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$
          [Char] -> [Char] -> Maybe [Char]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([Char]
directory [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]) [Char]
filePath

-- | Extract the test names from discovered modules.
extractTests :: FilePath -> String -> [Test]
extractTests :: [Char] -> [Char] -> [Test]
extractTests [Char]
file [Char]
content = [[Char]] -> [Test]
mkTestDeDuped ([[Char]] -> [Test]) -> ([Char] -> [[Char]]) -> [Char] -> [Test]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
isKnownPrefix ([[Char]] -> [[Char]])
-> ([Char] -> [[Char]]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
parseTest ([Char] -> [[Char]]) -> ([Char] -> [Char]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [Char]
preprocessHaskell ([Char] -> [Test]) -> [Char] -> [Test]
forall a b. (a -> b) -> a -> b
$ [Char]
content
  where mkTestDeDuped :: [String] -> [Test]
        mkTestDeDuped :: [[Char]] -> [Test]
mkTestDeDuped = ([Char] -> Test) -> [[Char]] -> [Test]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> Test
mkTest [Char]
file) ([[Char]] -> [Test])
-> ([[Char]] -> [[Char]]) -> [[Char]] -> [Test]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [[Char]]
forall a. Eq a => [a] -> [a]
nub

        isKnownPrefix :: [String] -> [String]
        isKnownPrefix :: [[Char]] -> [[Char]]
isKnownPrefix = ([Char] -> Bool) -> [[Char]] -> [[Char]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[Char]
g -> (Generator -> Bool) -> [Generator] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([Char] -> Generator -> Bool
checkPrefix [Char]
g) [Generator]
generators)

        checkPrefix :: String -> Generator -> Bool
        checkPrefix :: [Char] -> Generator -> Bool
checkPrefix [Char]
g = ([Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Char]
g) ([Char] -> Bool) -> (Generator -> [Char]) -> Generator -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Generator -> [Char]
generatorPrefix

        parseTest :: String -> [String]
        parseTest :: [Char] -> [[Char]]
parseTest     = (([Char], [Char]) -> [Char]) -> [([Char], [Char])] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], [Char]) -> [Char]
forall a b. (a, b) -> a
fst ([([Char], [Char])] -> [[Char]])
-> ([Char] -> [([Char], [Char])]) -> [Char] -> [[Char]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [([Char], [Char])]) -> [[Char]] -> [([Char], [Char])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap [Char] -> [([Char], [Char])]
lex ([[Char]] -> [([Char], [Char])])
-> ([Char] -> [[Char]]) -> [Char] -> [([Char], [Char])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> [[Char]]
lines

-- | Preprocess Haskell source to remove block comments only
preprocessHaskell :: String -> String
preprocessHaskell :: [Char] -> [Char]
preprocessHaskell = [Char] -> [Char]
removeBlockComments

-- | Remove {- -} block comments (handles nesting)
removeBlockComments :: String -> String
removeBlockComments :: [Char] -> [Char]
removeBlockComments = Int -> [Char] -> [Char]
forall {a}. (Num a, Ord a) => a -> [Char] -> [Char]
go (Int
0 :: Int)
  where
    go :: a -> [Char] -> [Char]
go a
_ [] = []
    go a
depth (Char
'{':Char
'-':[Char]
rest) = a -> [Char] -> [Char]
go (a
depth a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) [Char]
rest
    go a
depth (Char
'-':Char
'}':[Char]
rest) 
      | a
depth a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0 = a -> [Char] -> [Char]
go (a
depth a -> a -> a
forall a. Num a => a -> a -> a
- a
1) [Char]
rest
      | Bool
otherwise = Char
'-' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'}' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: a -> [Char] -> [Char]
go a
depth [Char]
rest
    go a
0 (Char
c:[Char]
rest) = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: a -> [Char] -> [Char]
go a
0 [Char]
rest
    go a
depth (Char
_:[Char]
rest) = a -> [Char] -> [Char]
go a
depth [Char]
rest

-- | Show the imports.
showImports :: [String] -> [String]
showImports :: [[Char]] -> [[Char]]
showImports [[Char]]
mods = [[Char]] -> [[Char]]
forall a. Ord a => [a] -> [a]
sort ([[Char]] -> [[Char]]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char]
"import qualified " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) [[Char]]
mods

-- | Retrieve the ingredient name.
ingredientImport :: String -> String
ingredientImport :: [Char] -> [Char]
ingredientImport = [Char] -> [Char]
forall a. HasCallStack => [a] -> [a]
init ([Char] -> [Char]) -> ([Char] -> [Char]) -> [Char] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'.')

-- | Ingredients to be included.
ingredients :: [String] -> String
ingredients :: [[Char]] -> [Char]
ingredients [[Char]]
is = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char]) -> [[Char]] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
":") [[Char]]
is [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]
"T.defaultIngredients"]

-- | Show the tests.
showTests :: Config -> [Test] -> [String] -> [String]
showTests :: Config -> [Test] -> [[Char]] -> [[Char]]
showTests Config
config [Test]
tests [[Char]]
testNumVars = if Config -> Bool
treeDisplay Config
config
  then ModuleTree -> [[Char]]
showModuleTree (ModuleTree -> [[Char]]) -> ModuleTree -> [[Char]]
forall a b. (a -> b) -> a -> b
$ [Test] -> [[Char]] -> ModuleTree
mkModuleTree [Test]
tests [[Char]]
testNumVars
  else ([Char] -> Test -> [Char]) -> [[Char]] -> [Test] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> Test -> [Char]
forall a b. a -> b -> a
const [[Char]]
testNumVars [Test]
tests

newtype ModuleTree = ModuleTree (M.Map String (ModuleTree, [String]))
  deriving stock (ModuleTree -> ModuleTree -> Bool
(ModuleTree -> ModuleTree -> Bool)
-> (ModuleTree -> ModuleTree -> Bool) -> Eq ModuleTree
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModuleTree -> ModuleTree -> Bool
== :: ModuleTree -> ModuleTree -> Bool
$c/= :: ModuleTree -> ModuleTree -> Bool
/= :: ModuleTree -> ModuleTree -> Bool
Eq, Int -> ModuleTree -> [Char] -> [Char]
[ModuleTree] -> [Char] -> [Char]
ModuleTree -> [Char]
(Int -> ModuleTree -> [Char] -> [Char])
-> (ModuleTree -> [Char])
-> ([ModuleTree] -> [Char] -> [Char])
-> Show ModuleTree
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
$cshowsPrec :: Int -> ModuleTree -> [Char] -> [Char]
showsPrec :: Int -> ModuleTree -> [Char] -> [Char]
$cshow :: ModuleTree -> [Char]
show :: ModuleTree -> [Char]
$cshowList :: [ModuleTree] -> [Char] -> [Char]
showList :: [ModuleTree] -> [Char] -> [Char]
Show)

showModuleTree :: ModuleTree -> [String]
showModuleTree :: ModuleTree -> [[Char]]
showModuleTree (ModuleTree Map [Char] (ModuleTree, [[Char]])
mdls) = (([Char], (ModuleTree, [[Char]])) -> [Char])
-> [([Char], (ModuleTree, [[Char]]))] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map ([Char], (ModuleTree, [[Char]])) -> [Char]
showModule ([([Char], (ModuleTree, [[Char]]))] -> [[Char]])
-> [([Char], (ModuleTree, [[Char]]))] -> [[Char]]
forall a b. (a -> b) -> a -> b
$ Map [Char] (ModuleTree, [[Char]])
-> [([Char], (ModuleTree, [[Char]]))]
forall k a. Map k a -> [(k, a)]
M.assocs Map [Char] (ModuleTree, [[Char]])
mdls
  where -- special case, collapse to mdl.submdl
        showModule :: ([Char], (ModuleTree, [String])) -> [Char]
        showModule :: ([Char], (ModuleTree, [[Char]])) -> [Char]
showModule ([Char]
mdl, (ModuleTree Map [Char] (ModuleTree, [[Char]])
subMdls, [])) | Map [Char] (ModuleTree, [[Char]]) -> Int
forall k a. Map k a -> Int
M.size Map [Char] (ModuleTree, [[Char]])
subMdls Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 =
          case Map [Char] (ModuleTree, [[Char]])
-> [([Char], (ModuleTree, [[Char]]))]
forall k a. Map k a -> [(k, a)]
M.assocs Map [Char] (ModuleTree, [[Char]])
subMdls of
            [([Char]
subMdl, (ModuleTree
subSubTree, [[Char]]
testVars))] -> ([Char], (ModuleTree, [[Char]])) -> [Char]
showModule ([Char]
mdl [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Char
'.' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
subMdl, (ModuleTree
subSubTree, [[Char]]
testVars))
            [([Char], (ModuleTree, [[Char]]))]
as -> [Char] -> [Char]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
"Excepted number of submodules != 1.  Found " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show ([([Char], (ModuleTree, [[Char]]))] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [([Char], (ModuleTree, [[Char]]))]
as)
        showModule ([Char]
mdl, (ModuleTree
subTree, [[Char]]
testVars)) = [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char]
"T.testGroup \"", [Char]
mdl
          , [Char]
"\" [", [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," (ModuleTree -> [[Char]]
showModuleTree ModuleTree
subTree [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
testVars), [Char]
"]" ]

mkModuleTree :: [Test] -> [String] -> ModuleTree
mkModuleTree :: [Test] -> [[Char]] -> ModuleTree
mkModuleTree [Test]
tests [[Char]]
testVars = Map [Char] (ModuleTree, [[Char]]) -> ModuleTree
ModuleTree (Map [Char] (ModuleTree, [[Char]]) -> ModuleTree)
-> Map [Char] (ModuleTree, [[Char]]) -> ModuleTree
forall a b. (a -> b) -> a -> b
$
    (([Char], [Char])
 -> Map [Char] (ModuleTree, [[Char]])
 -> Map [Char] (ModuleTree, [[Char]]))
-> Map [Char] (ModuleTree, [[Char]])
-> [([Char], [Char])]
-> Map [Char] (ModuleTree, [[Char]])
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ([Char], [Char])
-> Map [Char] (ModuleTree, [[Char]])
-> Map [Char] (ModuleTree, [[Char]])
go Map [Char] (ModuleTree, [[Char]])
forall k a. Map k a
M.empty ([([Char], [Char])] -> Map [Char] (ModuleTree, [[Char]]))
-> [([Char], [Char])] -> Map [Char] (ModuleTree, [[Char]])
forall a b. (a -> b) -> a -> b
$ (Test -> [Char] -> ([Char], [Char]))
-> [Test] -> [[Char]] -> [([Char], [Char])]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Test
t [Char]
tVar -> (Test -> [Char]
testModule Test
t, [Char]
tVar)) [Test]
tests [[Char]]
testVars
  where go :: ([Char], [Char])
-> Map [Char] (ModuleTree, [[Char]])
-> Map [Char] (ModuleTree, [[Char]])
go ([Char]
mdl, [Char]
tVar) Map [Char] (ModuleTree, [[Char]])
mdls = ((ModuleTree, [[Char]])
 -> (ModuleTree, [[Char]]) -> (ModuleTree, [[Char]]))
-> [Char]
-> (ModuleTree, [[Char]])
-> Map [Char] (ModuleTree, [[Char]])
-> Map [Char] (ModuleTree, [[Char]])
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
M.insertWith (ModuleTree, [[Char]])
-> (ModuleTree, [[Char]]) -> (ModuleTree, [[Char]])
merge [Char]
key (ModuleTree, [[Char]])
val Map [Char] (ModuleTree, [[Char]])
mdls
          where ([Char]
key, (ModuleTree, [[Char]])
val) = case (Char -> Bool) -> [Char] -> ([Char], [Char])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') [Char]
mdl of
                  ([Char]
_, [])              -> ([Char]
mdl, (Map [Char] (ModuleTree, [[Char]]) -> ModuleTree
ModuleTree Map [Char] (ModuleTree, [[Char]])
forall k a. Map k a
M.empty, [[Char]
tVar]))
                  ([Char]
topMdl, Char
'.':[Char]
subMdl) -> ([Char]
topMdl, (Map [Char] (ModuleTree, [[Char]]) -> ModuleTree
ModuleTree (Map [Char] (ModuleTree, [[Char]]) -> ModuleTree)
-> Map [Char] (ModuleTree, [[Char]]) -> ModuleTree
forall a b. (a -> b) -> a -> b
$ ([Char], [Char])
-> Map [Char] (ModuleTree, [[Char]])
-> Map [Char] (ModuleTree, [[Char]])
go ([Char]
subMdl, [Char]
tVar) Map [Char] (ModuleTree, [[Char]])
forall k a. Map k a
M.empty, []))
                  ([Char], [Char])
_                    -> [Char] -> ([Char], (ModuleTree, [[Char]]))
forall a. HasCallStack => [Char] -> a
error [Char]
"impossible case in mkModuleTree.go.key"
        merge :: (ModuleTree, [[Char]])
-> (ModuleTree, [[Char]]) -> (ModuleTree, [[Char]])
merge (ModuleTree Map [Char] (ModuleTree, [[Char]])
mdls1, [[Char]]
tVars1) (ModuleTree Map [Char] (ModuleTree, [[Char]])
mdls2, [[Char]]
tVars2) =
          (Map [Char] (ModuleTree, [[Char]]) -> ModuleTree
ModuleTree (Map [Char] (ModuleTree, [[Char]]) -> ModuleTree)
-> Map [Char] (ModuleTree, [[Char]]) -> ModuleTree
forall a b. (a -> b) -> a -> b
$ ((ModuleTree, [[Char]])
 -> (ModuleTree, [[Char]]) -> (ModuleTree, [[Char]]))
-> Map [Char] (ModuleTree, [[Char]])
-> Map [Char] (ModuleTree, [[Char]])
-> Map [Char] (ModuleTree, [[Char]])
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
M.unionWith (ModuleTree, [[Char]])
-> (ModuleTree, [[Char]]) -> (ModuleTree, [[Char]])
merge Map [Char] (ModuleTree, [[Char]])
mdls1 Map [Char] (ModuleTree, [[Char]])
mdls2, [[Char]]
tVars1 [[Char]] -> [[Char]] -> [[Char]]
forall a. [a] -> [a] -> [a]
++ [[Char]]
tVars2)