{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}

-----------------------------------------------------------------------------

-- |
-- Module      :  Distribution.Simple.Program.Hpc
-- Copyright   :  Thomas Tuegel 2011
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This module provides an library interface to the @hpc@ program.
module Distribution.Simple.Program.Hpc
  ( markup
  , union
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import System.Directory (makeRelativeToCurrentDirectory)

import Distribution.ModuleName
import Distribution.Pretty
import Distribution.Simple.Program.Run
import Distribution.Simple.Program.Types
import Distribution.Simple.Utils
import Distribution.Verbosity
import Distribution.Version

-- | Invoke hpc with the given parameters.
--
-- Prior to HPC version 0.7 (packaged with GHC 7.8), hpc did not handle
-- multiple .mix paths correctly, so we print a warning, and only pass it the
-- first path in the list. This means that e.g. test suites that import their
-- library as a dependency can still work, but those that include the library
-- modules directly (in other-modules) don't.
markup
  :: ConfiguredProgram
  -> Version
  -> Verbosity
  -> FilePath
  -- ^ Path to .tix file
  -> [FilePath]
  -- ^ Paths to .mix file directories
  -> FilePath
  -- ^ Path where html output should be located
  -> [ModuleName]
  -- ^ List of modules to include in the report
  -> IO ()
markup :: ConfiguredProgram
-> Version
-> Verbosity
-> FilePath
-> [FilePath]
-> FilePath
-> [ModuleName]
-> IO ()
markup ConfiguredProgram
hpc Version
hpcVer Verbosity
verbosity FilePath
tixFile [FilePath]
hpcDirs FilePath
destDir [ModuleName]
included = do
  hpcDirs' <-
    if Version -> VersionRange -> Bool
withinRange Version
hpcVer (Version -> VersionRange
orLaterVersion Version
version07)
      then [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
hpcDirs
      else do
        Verbosity -> FilePath -> IO ()
warn Verbosity
verbosity (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
          FilePath
"Your version of HPC ("
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Version -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow Version
hpcVer
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
") does not properly handle multiple search paths. "
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"Coverage report generation may fail unexpectedly. These "
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"issues are addressed in version 0.7 or later (GHC 7.8 or "
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"later)."
            FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ if [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
droppedDirs
              then FilePath
""
              else
                FilePath
" The following search paths have been abandoned: "
                  FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
forall a. Show a => a -> FilePath
show [FilePath]
droppedDirs
        [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
passedDirs

  -- Prior to GHC 8.0, hpc assumes all .mix paths are relative.
  hpcDirs'' <- traverse makeRelativeToCurrentDirectory hpcDirs'

  runProgramInvocation
    verbosity
    (markupInvocation hpc tixFile hpcDirs'' destDir included)
  where
    version07 :: Version
version07 = [Int] -> Version
mkVersion [Int
0, Int
7]
    ([FilePath]
passedDirs, [FilePath]
droppedDirs) = Int -> [FilePath] -> ([FilePath], [FilePath])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
1 [FilePath]
hpcDirs

markupInvocation
  :: ConfiguredProgram
  -> FilePath
  -- ^ Path to .tix file
  -> [FilePath]
  -- ^ Paths to .mix file directories
  -> FilePath
  -- ^ Path where html output should be
  -- located
  -> [ModuleName]
  -- ^ List of modules to include
  -> ProgramInvocation
markupInvocation :: ConfiguredProgram
-> FilePath
-> [FilePath]
-> FilePath
-> [ModuleName]
-> ProgramInvocation
markupInvocation ConfiguredProgram
hpc FilePath
tixFile [FilePath]
hpcDirs FilePath
destDir [ModuleName]
included =
  let args :: [FilePath]
args =
        [ FilePath
"markup"
        , FilePath
tixFile
        , FilePath
"--destdir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
destDir
        ]
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
"--hpcdir=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
hpcDirs
          [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ [ FilePath
"--include=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
moduleName
             | ModuleName
moduleName <- [ModuleName]
included
             ]
   in ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
hpc [FilePath]
args

union
  :: ConfiguredProgram
  -> Verbosity
  -> [FilePath]
  -- ^ Paths to .tix files
  -> FilePath
  -- ^ Path to resultant .tix file
  -> [ModuleName]
  -- ^ List of modules to exclude from union
  -> IO ()
union :: ConfiguredProgram
-> Verbosity -> [FilePath] -> FilePath -> [ModuleName] -> IO ()
union ConfiguredProgram
hpc Verbosity
verbosity [FilePath]
tixFiles FilePath
outFile [ModuleName]
excluded =
  Verbosity -> ProgramInvocation -> IO ()
runProgramInvocation
    Verbosity
verbosity
    (ConfiguredProgram
-> [FilePath] -> FilePath -> [ModuleName] -> ProgramInvocation
unionInvocation ConfiguredProgram
hpc [FilePath]
tixFiles FilePath
outFile [ModuleName]
excluded)

unionInvocation
  :: ConfiguredProgram
  -> [FilePath]
  -- ^ Paths to .tix files
  -> FilePath
  -- ^ Path to resultant .tix file
  -> [ModuleName]
  -- ^ List of modules to exclude from union
  -> ProgramInvocation
unionInvocation :: ConfiguredProgram
-> [FilePath] -> FilePath -> [ModuleName] -> ProgramInvocation
unionInvocation ConfiguredProgram
hpc [FilePath]
tixFiles FilePath
outFile [ModuleName]
excluded =
  ConfiguredProgram -> [FilePath] -> ProgramInvocation
programInvocation ConfiguredProgram
hpc ([FilePath] -> ProgramInvocation)
-> [FilePath] -> ProgramInvocation
forall a b. (a -> b) -> a -> b
$
    [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
      [ [FilePath
"sum", FilePath
"--union"]
      , [FilePath]
tixFiles
      , [FilePath
"--output=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
outFile]
      , [ FilePath
"--exclude=" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ModuleName -> FilePath
forall a. Pretty a => a -> FilePath
prettyShow ModuleName
moduleName
        | ModuleName
moduleName <- [ModuleName]
excluded
        ]
      ]