{-# LANGUAGE CPP #-}
-- | Test codes for running @hpc-codecov@ executable.
module Test.Main (main) where

-- base
import           Control.Exception           (SomeException (..), try)
import           Control.Monad               (when)
import           Data.Char                   (toLower)
import           Data.List                   (isPrefixOf, isSubsequenceOf)
import           Data.Maybe                  (fromMaybe, isJust)
import           System.Environment          (getExecutablePath, lookupEnv,
                                              setEnv, unsetEnv, withArgs)
import           System.Exit                 (ExitCode)
import           System.IO                   (IOMode (..), hClose,
                                              hGetContents, openBinaryFile,
                                              openTempFile)
import           System.Info                 (os)

#if !MIN_VERSION_base(4,11,0)
import           Data.Monoid                 ((<>))
#endif


-- filepath
import           System.FilePath             (joinPath, takeFileName,
                                              (</>))

-- directory
import           System.Directory            (canonicalizePath,
                                              doesDirectoryExist,
                                              listDirectory,
                                              removeDirectoryRecursive,
                                              removeFile,
                                              withCurrentDirectory)

-- hpc
import           Trace.Hpc.Mix               (readMix)
import           Trace.Hpc.Tix               (readTix)

-- process
import           System.Process              (CreateProcess (..),
                                              callProcess, shell,
                                              waitForProcess,
                                              withCreateProcess)

-- tasty
import           Test.Tasty                  (DependencyType (..),
                                              TestTree, after, defaultMain,
                                              testGroup, withResource)
import           Test.Tasty.HUnit            (assertEqual, assertFailure,
                                              testCase)

-- tasty-golden
import           Test.Tasty.Golden           (goldenVsFile,
                                              writeBinaryFile)

-- Internal
import           Trace.Hpc.Codecov.Discover
import           Trace.Hpc.Codecov.Exception
import qualified Trace.Hpc.Codecov.Main      as HpcCodecov
import           Trace.Hpc.Codecov.Parser
import           Trace.Hpc.Codecov.Report


-- ------------------------------------------------------------------------
--
-- Tests
--
-- ------------------------------------------------------------------------

main :: IO ()
main = do
  test_in_test <- isTestInTest
  mb_tool <- getBuildTool

  when test_in_test $ putStr $ unlines
    [ ""
    , "================================="
    , "Running test to generate hpc data"
    , "================================="
    , "" ]

  defaultMain $ testGroup "main" $
    [reportTest, cmdline, recipReport, exceptionTest, parserTest] ++
    [selfReportTest | not test_in_test, isJust mb_tool] ++
    [discoverStackTest | not test_in_test, mb_tool == Just Stack] ++
    [discoverCabalTest | not test_in_test, mb_tool == Just Cabal]

parserTest :: TestTree
parserTest = testGroup "parser"
  [ testGroup "readTix'"
    [ testCase "compare" $ do
        let read_with f = f (reciprocal_dir </> "reciprocal.tix")
        tix1 <- read_with readTix
        tix2 <- read_with readTix'
        assertEqual "readTix'" tix1 tix2
    ]

  , testGroup "readMix'"
    [ testCase "compare" $ do
        let read_with f = f [reciprocal_dir </> ".hpc"] (Left "Main")
        mix1 <- read_with readMix
        mix2 <- read_with readMix'
        assertEqual "readMix'" mix1 mix2

    , testCase "malformed timestamp" $
        shouldFail $ readMix' [reciprocal_dir </> ".hpc"] (Left "Malformed")
    ]
  ]
  where
    reciprocal_dir = joinPath ["test", "data", "reciprocal"]

exceptionTest :: TestTree
exceptionTest = testGroup "exception"
  [ testCase "NoTarget" $ assertEqual "NoTarget" "NoTarget" (show NoTarget)
  , testCase "TixNotFound" $
    assertEqual "TixNotFound" "TixNotFound \"foo\"" (show (TixNotFound "foo"))
  ]

reportTest :: TestTree
reportTest = testGroup "report"
  [ testCase "mempty" $ do
      shouldFail (print $ reportTix mempty)
      assertEqual "empty mix dirs" (reportMixDirs mempty) []
      assertEqual "empty src dirs" (reportSrcDirs mempty) []
      assertEqual "non verbose" (reportVerbose mempty) False
      let r1 = mempty { reportExcludes = ["M1"] }
          r2 = mempty { reportExcludes = ["M2", "M3"]
                      , reportVerbose = True }
          r3 = r1 <> r2
      assertEqual "<> for verbose" (reportVerbose r3) True
      assertEqual "<> for excludes" (reportExcludes r3) ["M1","M2","M3"]
  ]

cmdline :: TestTree
cmdline = testGroup "cmdline"
  [ testCase "non-existing-option"
             (shouldFail (main' ["--foo"]))
  , testCase "non-existing-options"
             (shouldFail (main' ["--foo", "--bar", "--buzz"]))
  , testCase "mixdir-without-argument"
             (shouldFail (main' ["--mix"]))
  , testCase "no-tix-file"
             (shouldFail (main' []))
  , testCase "non-existing-tix"
             (shouldFail (main' ["no_such_file.tix"]))
  , testCase "invalid-build-tool"
              (shouldFail (main' ["foo:tests"]))
  , testCase "invalid-test-suite"
              (shouldFail (main' ["cabal:no-such-test"]))
  , testCase "invalid-format"
             (shouldFail (main' ["--format=foo"]))
  , testCase "help" (main' ["--help"])
  , testCase "version" (main' ["--version"])
  , testCase "numeric-version" (main' ["--numeric-version"])
  ]

recipReport :: TestTree
recipReport = testGroup "recip"
  [ testCase "recip-data-to-stdout"
             (main' ["--mix=test/data/reciprocal/.hpc"
                    ,"--src=test/data/reciprocal"
                    ,"--exclude=NoSuchModule"
                    ,"--verbose"
                    ,"test/data/reciprocal/reciprocal.tix"])
  , testCase "recip-lcov-data-to-stdout"
             (main' ["--mix=test/data/reciprocal/.hpc"
                    ,"--src=test/data/reciprocal"
                    ,"--verbose"
                    ,"--format=lcov"
                    ,"test/data/reciprocal/reciprocal.tix"])
  , testCase "recip-cobertura-data-to-stdout"
             (main' ["--mix=test/data/reciprocal/.hpc"
                    ,"--src=test/data/reciprocal"
                    ,"--verbose"
                    ,"--format=cobertura"
                    ,"test/data/reciprocal/reciprocal.tix"])
  , testCase "recip-data-no-src"
             (shouldFail
                (main' ["--mix=test/data/reciprocal/.hpc"
                       ,"--src=test/"
                       ,"--src=test/data"
                       ,"--verbose"
                       ,"test/data/reciprocal/reciprocal.tix"]))
  ]

-- Note: Running test to generate .mix and .tix of hpc-codecov package
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
--
-- The test recursively runs itself to generate .mix and .tix files of
-- the hpc-codecov package itself.
--
-- To terminate the recursive run, the "main" function in this module
-- is looking up an environment variable to check whether the test is
-- running inside the test or not. Recursive run is done only for the
-- known build tool (e.g.: cabal install, stack).

selfReportTest :: TestTree
selfReportTest = withTempDir work1
  where
    work1 getDir =
      withResource (acquire getDir) release selfReport
    acquire getDir =
      setEnv testInTestKey "TRUE" >> getDir >>= getSelfReportArgs
    release _ =
      unsetEnv testInTestKey

-- | Self Report Arguments
data SRA =
  SRA { sra_tix      :: FilePath
      , sra_mixs     :: [FilePath]
      , sra_excludes :: [String]
      , sra_verbose  :: Bool
      , sra_format   :: Format
      , sra_out      :: Maybe FilePath
      }

emptySRA :: SRA
emptySRA = SRA { sra_tix = ""
               , sra_mixs = []
               , sra_excludes = []
               , sra_verbose = False
               , sra_format = Codecov
               , sra_out = Nothing }

getBuildTool :: IO (Maybe BuildTool)
getBuildTool = do
  path <- getExecutablePath
  if ".stack-work" `isSubsequenceOf` path
     then return $ Just Stack
     else if "dist-newstyle" `isSubsequenceOf` path
       then return $ Just Cabal
       else return Nothing

getSelfReportArgs :: FilePath -> IO SRA
getSelfReportArgs builddir = do
  mb_tool <- getBuildTool
  case mb_tool of
    Just Stack -> getSelfReportStackArgs builddir
    Just Cabal -> getSelfReportCabalArgs setupV2 builddir
    _          -> error "Cannot determine build tool"

getSelfReportStackArgs :: FilePath -> IO SRA
getSelfReportStackArgs wd = do
  callProcess "stack" [ "--work-dir=" ++ wd, "test", "--coverage"]
  mb_tix <- findUnder (\p -> takeFileName p == "test-main.tix") wd
  mb_mix <- findUnder (\p -> takeFileName p == "hpc") (wd </> "dist")
  case (mb_tix, mb_mix) of
    (Just tix, Just mix) -> do
      return emptySRA { sra_tix = tix
                      , sra_mixs = [mix]
                      , sra_excludes = ["Paths_hpc_codecov"] }
    _ -> error "getting arguments for self test with stack failed"

-- setupV1 :: FilePath -> IO ()
-- setupV1 bd = bracket acquire release work
--   where
--     -- Cabal v1 style build complains when "GHC_PACKAGE_PATH"
--     -- environment were set, manually removing the variable.
--     key = "GHC_PACKAGE_PATH"

--     acquire = do
--       mb_ghc_pkg_path <- lookupEnv key
--       putStrLn $ "GHC_PACKAGE_PATH: " ++ show mb_ghc_pkg_path
--       unsetEnv key
--       pure mb_ghc_pkg_path

--     release = mapM_ (setEnv key)

--     work _ = do
--       let setup args = callProcess "runhaskell" ("Setup.hs" : args)

--       setup [ "configure", "--builddir=" ++ bd
--             , "--enable-test", "--enable-coverage"
--             , "--package-db=/build/package.conf.d" ]

--       setup ["build", "--builddir=" ++ bd]
--       setup ["test", "--builddir=" ++ bd]

setupV2 :: FilePath -> IO ()
setupV2 bd =
  callProcess "cabal" [ "test", "--builddir=" ++ bd, "--enable-coverage"]

getSelfReportCabalArgs :: (FilePath -> IO ()) -> FilePath -> IO SRA
getSelfReportCabalArgs setup bd = do
  setup bd
  mb_tix <- findUnder (\p -> takeFileName p == "test-main.tix") bd
  putStrLn $ "tix: " ++ show mb_tix
  mb_vanilla <- findUnder (\p -> takeFileName p == "vanilla") bd
  putStrLn $ "vanilla: " ++ show mb_vanilla
  case (mb_tix, mb_vanilla) of
    (Nothing, Nothing) -> error "failed to find tix and vanilla"
    (Nothing, _) -> error "failed to find tix"
    (_, Nothing) -> error "failed to find vanilla"
    (Just tix, Just vanilla) -> do
      let mixdir = vanilla </> "mix"
      mixs <- map (mixdir </>) <$> listDirectory mixdir
      return emptySRA { sra_tix = tix
                      , sra_mixs = mixs
                      , sra_excludes = ["Main", "Paths_hpc_codecov"] }

selfReport :: IO SRA -> TestTree
selfReport getArgs = testGroup "self"
  [ testCase "self-data-to-stdout"
             (getArgs >>= sraMain)
  , testCase "self-data-to-stdout-lcov"
    (do args <- getArgs
        sraMain (args {sra_format=Lcov}))
  , testCase "self-data-to-stdout-cobertura"
    (do args <- getArgs
        sraMain (args {sra_format=Cobertura}))
  , testCase "self-data-to-stdout-verbose"
             (do args <- getArgs
                 sraMain (args {sra_verbose=True}))
  , withTempFile
      (\getPath ->
         testCase "self-data-to-file-verbose"
                  (do path <- getPath
                      args <- getArgs
                      sraMain (args {sra_out=Just path
                                    ,sra_verbose=True})))
  , testCase "self-data-no-mix-none"
             (getArgs >>= shouldFail . sraMain . tixOnly)
  , testCase "self-data-no-mix-one"
             (do args <- getArgs
                 shouldFail (sraMain ((tixOnly args) {sra_mixs=["foo"]})))
  , testCase "self-data-no-all-two"
             (do args <- getArgs
                 let args' = (tixOnly args) { sra_mixs = ["foo", "bar"] }
                 shouldFail (sraMain args'))
  ]
  where
    tixOnly sra = emptySRA { sra_tix = sra_tix sra }


-- ------------------------------------------------------------------------
--
-- Discover tests
--
-- ------------------------------------------------------------------------

discoverStackTest :: TestTree
discoverStackTest =
  let t = buildAndTestWithStack
      withProject name act = case getAcquireAndRelease Stack name [] of
        (a,r) -> withResource a r (const act)
  in  testGroup "discover_stack"
        [ testGroup "plain"
          [ t "project1"
            [ "--root=" ++ testData "project1"
            , "--verbose"
            , "stack:project1-test"]
            []
          ]

        , testGroup "dot-stack-work"
          [ t "project1"
            [ "--root=" ++ testData "project1"
            , "--verbose"
            , "--build=dot-stack-work"
            , "stack:project1-test.tix"]
            ["--work-dir=dot-stack-work"]
          ]

        , testGroup "lcov"
          [ t "project1"
            [ "--root=" ++ testData "project1"
            , "--verbose"
            , "--format=lcov"
            , "stack:project1-test"]
            []
          ]

        , testGroup "cobertura"
          [ t "project1"
            [ "--root=" ++ testData "project1"
            , "--verbose"
            , "--format=cobertura"
            , "--out=project1.xml"
            , "stack:project1-test"]
            []
          ]

        , after AllSucceed "cobertura.project1" $
          testGroup "golden"
          [ let ofile = "project1-refilled.xml"
                golden_file =
                  if os == "mingw32" then
                    "project1-windows.xml.golden"
                  else
                    "project1.xml.golden"
                golden_path = joinPath ["test", "data", "golden", golden_file]
                act = refillTimestampWithZero "project1.xml" ofile
            in  goldenVsFile "cobertura" golden_path ofile act
          ]

        , withProject "project1" $
            testCase "project1" $
              withCurrentDirectory (testData "project1") $ main'
                [ "--verbose", "stack:project1-test" ]

        , withProject "project1" $
            withResource
              (findUnder (\p -> takeFileName p == "project1-test.tix")
                         (testData "project1" </> ".stack-work"))
              (\_ -> pure ())
              (\getTixPath -> testCase "project1" $ do
                 tix_path <- fromMaybe "project1-test.tix" <$> getTixPath
                 canonical_tix_path <- canonicalizePath tix_path
                 putStrLn $
                   "tix_path: " ++ tix_path ++ "\n" ++
                   "canonical_tix_path: " ++ canonical_tix_path
                 main' [ "--verbose", "stack:" ++ canonical_tix_path ])
        ]

refillTimestampWithZero :: FilePath -> FilePath -> IO ()
refillTimestampWithZero ipath opath = do
  hdl <- openBinaryFile ipath ReadMode
  contents <- hGetContents hdl
  writeBinaryFile opath $
    unwords [ w' | w <- words contents
                 , let w' =
                         if "timestamp" `isPrefixOf` w
                         then "timestamp=\"0\""
                         else w ]

discoverCabalTest :: TestTree
discoverCabalTest =
  let t = buildAndTestWithCabal
      withProject name act = case getAcquireAndRelease Cabal name [] of
        (a,r) -> withResource a r (const act)
  in  testGroup "discover_cabal"
        [ t "project1"
          [ "--root=" ++ testData "project1"
          , "--verbose"
          , "-x", "Paths_project1"
          , "-X", "project1-exe"
          , "cabal:project1-test" ]
          []

        , withProject "project1" $
            withResource
              (findUnder (\p -> takeFileName p == "project1-test.tix")
                (testData "project1" </> "dist-newstyle"))
              (\_ -> pure ())
              (\getTixPath -> testCase "project1" $ do
                  tix_path <- fromMaybe "project1-test.tix" <$> getTixPath
                  canonical_tix_path <- canonicalizePath tix_path
                  main' [ "--verbose"
                        , "-x", "Main,Paths_project1"
                        , "-f", "lcov"
                        , "cabal:" ++ canonical_tix_path])
        ]

buildAndTestWithStack :: String -> [String] -> [String] -> TestTree
buildAndTestWithStack = buildAndTestWith Stack

buildAndTestWithCabal :: String -> [String] -> [String] -> TestTree
buildAndTestWithCabal = buildAndTestWith Cabal

buildAndTestWith :: BuildTool -> String -> [String] -> [String] -> TestTree
buildAndTestWith tool name args tool_args = withResource acquire release work
  where
    (acquire, release) = getAcquireAndRelease tool name tool_args
    work _ec = testCase name $ main' args

getAcquireAndRelease
  :: BuildTool -> String -> [String] -> (IO ExitCode, ExitCode -> IO ())
getAcquireAndRelease tool name tool_args = (acquire, release)
  where
    dir = testData name

    acq_cmd = case tool of
      Stack -> ("stack", ["test", "--coverage"])
      Cabal -> ("cabal", ["test", "--enable-coverage"])

    call (cmd,args) = callProcessIn dir cmd (tool_args ++ args)

    acquire = do
      putStrLn $ "Testing " ++ name ++ " with " ++ show tool ++ " ..."
      ec <- call acq_cmd
      putStrLn $ "ec: " ++ show ec
      return ec

    release _ec = pure ()

callProcessIn :: FilePath -> String -> [String] -> IO ExitCode
callProcessIn dir cmd args = withCreateProcess cp f
  where
    f _ _ _ = waitForProcess
    cp = (shell (unwords (cmd : args))) {cwd = Just dir}


-- ------------------------------------------------------------------------
--
-- Auxiliary functions
--
-- ------------------------------------------------------------------------

isTestInTest :: IO Bool
isTestInTest = isJust <$> lookupEnv testInTestKey

testInTestKey :: String
testInTestKey = "HPC_CODECOV_TEST_IN_TEST"

findUnder :: (FilePath -> Bool) -> FilePath -> IO (Maybe FilePath)
findUnder test root = foldDir f Nothing [root]
  where
    f _    acc@(Just _) = return acc
    f path Nothing =
      if test path
         then return (Just path)
         else return Nothing

-- | Wrapper to run 'Trace.Hpc.Codecov.Main.main' with given argument
-- strings.
main' :: [String] -> IO ()
main' args = withArgs args HpcCodecov.defaultMain

sraMain :: SRA -> IO ()
sraMain sra = main' args
  where
    args =
      map ("--mix=" ++) (sra_mixs sra) ++
      map ("--exclude=" ++) (sra_excludes sra) ++
      maybe [] (\p -> ["--out=" ++ p]) (sra_out sra) ++
      ["--verbose" | sra_verbose sra] ++
      ["--format=" ++ asFormat (sra_format sra)] ++
      [sra_tix sra]
    asFormat = map toLower . show

-- | Run test with path to temporary file.
withTempFile :: (IO FilePath -> TestTree) -> TestTree
withTempFile = withResource acquire release
  where
    acquire = do (path,hdl) <- openTempFile "." "test.tmp"
                 hClose hdl
                 return path
    release = removeFile

withTempDir :: (IO FilePath -> TestTree) -> TestTree
withTempDir = withResource acquire release
  where
     acquire = do
       mb_tool <- getBuildTool
       dir <- case mb_tool of
         Just Stack -> pure ".hpc_codecov_test_tmp_stack"
         Just Cabal -> pure ".hpc_codecov_test_tmp_cabal_v2"
         _          -> error "Cannot determine build tool"
       exists <- doesDirectoryExist dir
       when exists $ removeDirectoryRecursive dir
       pure dir
     release _ = return ()

-- | Pass the HUnit test when an exception was thrown, otherwise a
-- test failure.
shouldFail :: IO a -> IO ()
shouldFail act =
  do et_err <- try act
     case et_err of
       Left SomeException {} -> return ()
       _                     -> assertFailure "should fail"

-- | Get directory under test data.
testData :: String -> FilePath
testData dir = "test" </> "data" </> dir