    {-# 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
            ]
          ]