    {-# LANGUAGE CPP #-}
    -- | Automatic test discovery and runner for the tasty framework.

    module Test.Tasty.Discover (
      -- * Main Test Generator
      generateTestDriver

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

    import           Data.List                (dropWhileEnd, intercalate,
                                               isPrefixOf, nub, stripPrefix)
    import qualified Data.Map.Strict          as M
    import           Data.Maybe               (fromMaybe)
    #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
    import           System.FilePath          (pathSeparator, takeDirectory)
    import           System.FilePath.Glob     (compile, globDir1, match)
    import           System.IO                (IOMode (ReadMode), openFile)
    import           Test.Tasty.Config        (Config (..), GlobPattern)
    import           Test.Tasty.Generator     (Generator (..), Test (..),
                                               generators, getGenerators, mkTest,
                                               showSetup)

    -- | Main function generator, along with all the boilerplate which
    -- which will run the discovered tests.
    generateTestDriver :: Config -> String -> [String] -> FilePath -> [Test] -> String
    generateTestDriver :: Config -> String -> [String] -> String -> [Test] -> String
    generateTestDriver config :: Config
    config modname :: String
    modname is :: [String]
    is src :: String
    src tests :: [Test]
    tests =
      let generators' :: [Generator]
    generators' = [Test] -> [Generator]
    getGenerators [Test]
    tests
          testNumVars :: [String]
    testNumVars = (Int -> String) -> [Int] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (("t"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String) -> (Int -> String) -> Int -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show) [(0 :: Int)..]
      in
        [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [ "{-# LINE 1 " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    src String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " #-}\n"
          , "{-# LANGUAGE FlexibleInstances #-}\n"
          , "module " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    modname String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " (main, ingredients, tests) where\n"
          , "import Prelude\n"
          , "import qualified System.Environment as E\n"
          , "import qualified Test.Tasty as T\n"
          , "import qualified Test.Tasty.Ingredients as T\n"
          , [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Generator -> String) -> [Generator] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Generator -> String
    generatorImport [Generator]
    generators'
          , [String] -> String
    showImports ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> String
    ingredientImport [String]
    is [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (Test -> String) -> [Test] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Test -> String
    testModule [Test]
    tests)
          , [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Generator -> String) -> [Generator] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Generator -> String
    generatorClass [Generator]
    generators'
          , "tests :: IO T.TestTree\n"
          , "tests = do\n"
          , [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ (Test -> String -> String) -> [Test] -> [String] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Test -> String -> String
    showSetup [Test]
    tests [String]
    testNumVars
          , "  pure $ T.testGroup " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    src String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " ["
          , String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "," ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ Config -> [Test] -> [String] -> [String]
    showTests Config
    config [Test]
    tests [String]
    testNumVars
          , "]\n"
          , "ingredients :: [T.Ingredient]\n"
          , "ingredients = " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    ingredients [String]
    is String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n"
          , "main :: IO ()\n"
          , "main = do\n"
          , "  args <- E.getArgs\n"
          , "  E.withArgs (" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [String] -> String
    forall a. Show a => a -> String
    show (Config -> [String]
    tastyOptions Config
    config) String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ " ++ args) $"
          , "    tests >>= T.defaultMainWithIngredients ingredients\n"
          ]

    -- | Match files by specified glob pattern.
    filesByModuleGlob :: FilePath -> Maybe GlobPattern -> IO [String]
    filesByModuleGlob :: String -> Maybe String -> IO [String]
    filesByModuleGlob directory :: String
    directory globPattern :: Maybe String
    globPattern = do
      Pattern -> String -> IO [String]
    globDir1 Pattern
    pattern String
    directory
      where pattern :: Pattern
    pattern = String -> Pattern
    compile ("**/" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe "*.hs*" Maybe String
    globPattern)

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

    -- | Discover the tests modules.
    findTests :: FilePath -> Config -> IO [Test]
    findTests :: String -> Config -> IO [Test]
    findTests src :: String
    src config :: Config
    config = do
      let directory :: String
    directory = String -> String
    takeDirectory String
    src
      [String]
    allModules <- String -> Maybe String -> IO [String]
    filesByModuleGlob String
    directory (Config -> Maybe String
    modules Config
    config)
      let filtered :: [String]
    filtered = [String] -> Maybe String -> [String]
    ignoreByModuleGlob [String]
    allModules (Config -> Maybe String
    ignores Config
    config)
      [[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
    <$> (String -> IO [Test]) -> [String] -> IO [[Test]]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    traverse (String -> String -> IO [Test]
    extract String
    directory) [String]
    filtered
      where
        extract :: String -> String -> IO [Test]
    extract directory :: String
    directory filePath :: String
    filePath = do
          Handle
    h <- String -> IOMode -> IO Handle
    openFile String
    filePath IOMode
    ReadMode
    #if defined(mingw32_HOST_OS)
          -- Avoid internal error: hGetContents: invalid argument (invalid byte sequence)' non UTF-8 Windows
          hSetEncoding h $ mkLocaleEncoding TransliterateCodingFailure
    #endif
          String -> String -> [Test]
    extractTests (String -> String -> String
    dropDirectory String
    directory String
    filePath) (String -> [Test]) -> IO String -> IO [Test]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Handle -> IO String
    hGetContents Handle
    h
        dropDirectory :: String -> String -> String
    dropDirectory directory :: String
    directory filePath :: String
    filePath = String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    filePath (Maybe String -> String) -> Maybe String -> String
    forall a b. (a -> b) -> a -> b
    $
          String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix (String
    directory String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Char
    pathSeparator]) String
    filePath

    -- | Extract the test names from discovered modules.
    extractTests :: FilePath -> String -> [Test]
    extractTests :: String -> String -> [Test]
    extractTests file :: String
    file = [String] -> [Test]
    mkTestDeDuped ([String] -> [Test]) -> (String -> [String]) -> String -> [Test]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    isKnownPrefix ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    parseTest
      where
        mkTestDeDuped :: [String] -> [Test]
    mkTestDeDuped = (String -> Test) -> [String] -> [Test]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> String -> Test
    mkTest String
    file) ([String] -> [Test])
    -> ([String] -> [String]) -> [String] -> [Test]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub
        isKnownPrefix :: [String] -> [String]
    isKnownPrefix = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\g :: String
    g -> (Generator -> Bool) -> [Generator] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> Generator -> Bool
    checkPrefix String
    g) [Generator]
    generators)
        checkPrefix :: String -> Generator -> Bool
    checkPrefix g :: String
    g = (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    g) (String -> Bool) -> (Generator -> String) -> Generator -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Generator -> String
    generatorPrefix
        parseTest :: String -> [String]
    parseTest     = ((String, String) -> String) -> [(String, String)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, String) -> String
    forall a b. (a, b) -> a
    fst ([(String, String)] -> [String])
    -> (String -> [(String, String)]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> [(String, String)]) -> [String] -> [(String, String)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap String -> [(String, String)]
    lex ([String] -> [(String, String)])
    -> (String -> [String]) -> String -> [(String, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines

    -- | Show the imports.
    showImports :: [String] -> String
    showImports :: [String] -> String
    showImports mods :: [String]
    mods = [String] -> String
    unlines ([String] -> String) -> [String] -> String
    forall a b. (a -> b) -> a -> b
    $ [String] -> [String]
    forall a. Eq a => [a] -> [a]
    nub ([String] -> [String]) -> [String] -> [String]
    forall a b. (a -> b) -> a -> b
    $ (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (\m :: String
    m -> "import qualified " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    m String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ "\n") [String]
    mods

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

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

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

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

    showModuleTree :: ModuleTree -> [String]
    showModuleTree :: ModuleTree -> [String]
    showModuleTree (ModuleTree mdls :: Map String (ModuleTree, [String])
    mdls) = ((String, (ModuleTree, [String])) -> String)
    -> [(String, (ModuleTree, [String]))] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, (ModuleTree, [String])) -> String
    showModule ([(String, (ModuleTree, [String]))] -> [String])
    -> [(String, (ModuleTree, [String]))] -> [String]
    forall a b. (a -> b) -> a -> b
    $ Map String (ModuleTree, [String])
    -> [(String, (ModuleTree, [String]))]
    forall k a. Map k a -> [(k, a)]
    M.assocs Map String (ModuleTree, [String])
    mdls
      where
        -- special case, collapse to mdl.submdl
        showModule :: (String, (ModuleTree, [String])) -> String
    showModule (mdl :: String
    mdl, (ModuleTree subMdls :: Map String (ModuleTree, [String])
    subMdls, [])) | Map String (ModuleTree, [String]) -> Int
    forall k a. Map k a -> Int
    M.size Map String (ModuleTree, [String])
    subMdls Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == 1 =
          let [(subMdl :: String
    subMdl, (subSubTree :: ModuleTree
    subSubTree, testVars :: [String]
    testVars))] = Map String (ModuleTree, [String])
    -> [(String, (ModuleTree, [String]))]
    forall k a. Map k a -> [(k, a)]
    M.assocs Map String (ModuleTree, [String])
    subMdls
          in (String, (ModuleTree, [String])) -> String
    showModule (String
    mdl String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ '.' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    subMdl, (ModuleTree
    subSubTree, [String]
    testVars))
        showModule (mdl :: String
    mdl, (subTree :: ModuleTree
    subTree, testVars :: [String]
    testVars)) = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [ "T.testGroup \"", String
    mdl
          , "\" [", String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate "," (ModuleTree -> [String]
    showModuleTree ModuleTree
    subTree [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    testVars), "]" ]

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