    {-# LANGUAGE DataKinds #-}
    {-# 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 Distribution.ModuleName
    import Distribution.Pretty
    import Distribution.Simple.Program.Run
    import Distribution.Simple.Program.Types
    import Distribution.Simple.Utils
    import Distribution.Utils.Path
    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
      :: Maybe (SymbolicPath CWD (Dir Pkg))
      -> ConfiguredProgram
      -> Version
      -> Verbosity
      -> SymbolicPath Pkg File
      -- ^ Path to .tix file
      -> [SymbolicPath Pkg (Dir Mix)]
      -- ^ Paths to .mix file directories
      -> SymbolicPath Pkg (Dir Artifacts)
      -- ^ Path where html output should be located
      -> [ModuleName]
      -- ^ List of modules to include in the report
      -> IO ()
    markup :: Maybe (SymbolicPath CWD ('Dir Pkg))
    -> ConfiguredProgram
    -> Version
    -> Verbosity
    -> SymbolicPath Pkg 'File
    -> [SymbolicPath Pkg ('Dir Mix)]
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> [ModuleName]
    -> IO ()
    markup Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir ConfiguredProgram
    hpc Version
    hpcVer Verbosity
    verbosity SymbolicPath Pkg 'File
    tixFile [SymbolicPath Pkg ('Dir Mix)]
    hpcDirs SymbolicPath Pkg ('Dir Artifacts)
    destDir [ModuleName]
    included = do
      hpcDirs' <-
        if Version -> VersionRange -> Bool
    withinRange Version
    hpcVer (Version -> VersionRange
    orLaterVersion Version
    version07)
          then [SymbolicPath Pkg ('Dir Mix)] -> IO [SymbolicPath Pkg ('Dir Mix)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [SymbolicPath Pkg ('Dir Mix)]
    hpcDirs
          else do
            Verbosity -> String -> IO ()
    warn Verbosity
    verbosity (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $
              String
    "Your version of HPC ("
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Version -> String
    forall a. Pretty a => a -> String
    prettyShow Version
    hpcVer
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ") does not properly handle multiple search paths. "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "Coverage report generation may fail unexpectedly. These "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "issues are addressed in version 0.7 or later (GHC 7.8 or "
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "later)."
                String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ if [SymbolicPath Pkg ('Dir Mix)] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SymbolicPath Pkg ('Dir Mix)]
    droppedDirs
                  then String
    ""
                  else
                    String
    " The following search paths have been abandoned: "
                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [SymbolicPath Pkg ('Dir Mix)] -> String
    forall a. Show a => a -> String
    show [SymbolicPath Pkg ('Dir Mix)]
    droppedDirs
            [SymbolicPath Pkg ('Dir Mix)] -> IO [SymbolicPath Pkg ('Dir Mix)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return [SymbolicPath Pkg ('Dir Mix)]
    passedDirs

      -- Prior to GHC 8.0, hpc assumes all .mix paths are relative.
      hpcDirs'' <- traverse (tryMakeRelative mbWorkDir) hpcDirs'

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

    markupInvocation
      :: Maybe (SymbolicPath CWD (Dir Pkg))
      -> ConfiguredProgram
      -> SymbolicPath Pkg File
      -- ^ Path to .tix file
      -> [SymbolicPath Pkg (Dir Mix)]
      -- ^ Paths to .mix file directories
      -> SymbolicPath Pkg (Dir Artifacts)
      -- ^ Path where html output should be
      -- located
      -> [ModuleName]
      -- ^ List of modules to include
      -> ProgramInvocation
    markupInvocation :: Maybe (SymbolicPath CWD ('Dir Pkg))
    -> ConfiguredProgram
    -> SymbolicPath Pkg 'File
    -> [SymbolicPath Pkg ('Dir Mix)]
    -> SymbolicPath Pkg ('Dir Artifacts)
    -> [ModuleName]
    -> ProgramInvocation
    markupInvocation Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir ConfiguredProgram
    hpc SymbolicPath Pkg 'File
    tixFile [SymbolicPath Pkg ('Dir Mix)]
    hpcDirs SymbolicPath Pkg ('Dir Artifacts)
    destDir [ModuleName]
    included =
      let args :: [String]
    args =
            [ String
    "markup"
            , SymbolicPath Pkg 'File -> String
    forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
    SymbolicPathX allowAbsolute from to -> String
    getSymbolicPath SymbolicPath Pkg 'File
    tixFile
            , String
    "--destdir=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SymbolicPath Pkg ('Dir Artifacts) -> String
    forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
    SymbolicPathX allowAbsolute from to -> String
    getSymbolicPath SymbolicPath Pkg ('Dir Artifacts)
    destDir
            ]
              [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ (SymbolicPath Pkg ('Dir Mix) -> String)
    -> [SymbolicPath Pkg ('Dir Mix)] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String
    "--hpcdir=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++) (String -> String)
    -> (SymbolicPath Pkg ('Dir Mix) -> String)
    -> SymbolicPath Pkg ('Dir Mix)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SymbolicPath Pkg ('Dir Mix) -> String
    forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
    SymbolicPathX allowAbsolute from to -> String
    getSymbolicPath) [SymbolicPath Pkg ('Dir Mix)]
    hpcDirs
              [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [ String
    "--include=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> String
    forall a. Pretty a => a -> String
    prettyShow ModuleName
    moduleName
                 | ModuleName
    moduleName <- [ModuleName]
    included
                 ]
       in Maybe (SymbolicPath CWD ('Dir Pkg))
    -> ConfiguredProgram -> [String] -> ProgramInvocation
    forall to.
    Maybe (SymbolicPath CWD ('Dir to))
    -> ConfiguredProgram -> [String] -> ProgramInvocation
    programInvocationCwd Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir ConfiguredProgram
    hpc [String]
    args

    union
      :: Maybe (SymbolicPath CWD (Dir Pkg))
      -> ConfiguredProgram
      -> Verbosity
      -> [SymbolicPath Pkg File]
      -- ^ Paths to .tix files
      -> SymbolicPath Pkg File
      -- ^ Path to resultant .tix file
      -> [ModuleName]
      -- ^ List of modules to exclude from union
      -> IO ()
    union :: Maybe (SymbolicPath CWD ('Dir Pkg))
    -> ConfiguredProgram
    -> Verbosity
    -> [SymbolicPath Pkg 'File]
    -> SymbolicPath Pkg 'File
    -> [ModuleName]
    -> IO ()
    union Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir ConfiguredProgram
    hpc Verbosity
    verbosity [SymbolicPath Pkg 'File]
    tixFiles SymbolicPath Pkg 'File
    outFile [ModuleName]
    excluded =
      Verbosity -> ProgramInvocation -> IO ()
    runProgramInvocation
        Verbosity
    verbosity
        (Maybe (SymbolicPath CWD ('Dir Pkg))
    -> ConfiguredProgram
    -> [SymbolicPath Pkg 'File]
    -> SymbolicPath Pkg 'File
    -> [ModuleName]
    -> ProgramInvocation
    unionInvocation Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir ConfiguredProgram
    hpc [SymbolicPath Pkg 'File]
    tixFiles SymbolicPath Pkg 'File
    outFile [ModuleName]
    excluded)

    unionInvocation
      :: Maybe (SymbolicPath CWD (Dir Pkg))
      -> ConfiguredProgram
      -> [SymbolicPath Pkg File]
      -- ^ Paths to .tix files
      -> SymbolicPath Pkg File
      -- ^ Path to resultant .tix file
      -> [ModuleName]
      -- ^ List of modules to exclude from union
      -> ProgramInvocation
    unionInvocation :: Maybe (SymbolicPath CWD ('Dir Pkg))
    -> ConfiguredProgram
    -> [SymbolicPath Pkg 'File]
    -> SymbolicPath Pkg 'File
    -> [ModuleName]
    -> ProgramInvocation
    unionInvocation Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir ConfiguredProgram
    hpc [SymbolicPath Pkg 'File]
    tixFiles SymbolicPath Pkg 'File
    outFile [ModuleName]
    excluded =
      Maybe (SymbolicPath CWD ('Dir Pkg))
    -> ConfiguredProgram -> [String] -> ProgramInvocation
    forall to.
    Maybe (SymbolicPath CWD ('Dir to))
    -> ConfiguredProgram -> [String] -> ProgramInvocation
    programInvocationCwd Maybe (SymbolicPath CWD ('Dir Pkg))
    mbWorkDir ConfiguredProgram
    hpc ([String] -> ProgramInvocation) -> [String] -> ProgramInvocation
    forall a b. (a -> b) -> a -> b
    $
        [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
          [ [String
    "sum", String
    "--union"]
          , (SymbolicPath Pkg 'File -> String)
    -> [SymbolicPath Pkg 'File] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map SymbolicPath Pkg 'File -> String
    forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
    SymbolicPathX allowAbsolute from to -> String
    getSymbolicPath [SymbolicPath Pkg 'File]
    tixFiles
          , [String
    "--output=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SymbolicPath Pkg 'File -> String
    forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
    SymbolicPathX allowAbsolute from to -> String
    getSymbolicPath SymbolicPath Pkg 'File
    outFile]
          , [ String
    "--exclude=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ ModuleName -> String
    forall a. Pretty a => a -> String
    prettyShow ModuleName
    moduleName
            | ModuleName
    moduleName <- [ModuleName]
    excluded
            ]
          ]