Cabal/src/Distribution/Simple/Program/Hpc.hs

   1 {-# LANGUAGE FlexibleContexts #-}
   2 {-# LANGUAGE RankNTypes #-}
   3
   4 -----------------------------------------------------------------------------
   5
   6 -- |
   7 -- Module      :  Distribution.Simple.Program.Hpc
   8 -- Copyright   :  Thomas Tuegel 2011
   9 --
  10 -- Maintainer  :  cabal-devel@haskell.org
  11 -- Portability :  portable
  12 --
  13 -- This module provides an library interface to the @hpc@ program.
  14 module Distribution.Simple.Program.Hpc
  15   ( markup
  16   , union
  17   ) where
  18
  19 import Distribution.Compat.Prelude
  20 import Prelude ()
  21
  22 import System.Directory (makeRelativeToCurrentDirectory)
  23
  24 import Distribution.ModuleName
  25 import Distribution.Pretty
  26 import Distribution.Simple.Program.Run
  27 import Distribution.Simple.Program.Types
  28 import Distribution.Simple.Utils
  29 import Distribution.Verbosity
  30 import Distribution.Version
  31
  32 -- | Invoke hpc with the given parameters.
  33 --
  34 -- Prior to HPC version 0.7 (packaged with GHC 7.8), hpc did not handle
  35 -- multiple .mix paths correctly, so we print a warning, and only pass it the
  36 -- first path in the list. This means that e.g. test suites that import their
  37 -- library as a dependency can still work, but those that include the library
  38 -- modules directly (in other-modules) don't.
  39 markup
  40   :: ConfiguredProgram
  41   -> Version
  42   -> Verbosity
  43   -> FilePath
  44   -- ^ Path to .tix file
  45   -> [FilePath]
  46   -- ^ Paths to .mix file directories
  47   -> FilePath
  48   -- ^ Path where html output should be located
  49   -> [ModuleName]
  50   -- ^ List of modules to include in the report
  51   -> IO ()
  52 markup hpc hpcVer verbosity tixFile hpcDirs destDir included = do
  53   hpcDirs' <-
  54     if withinRange hpcVer (orLaterVersion version07)
  55       then return hpcDirs
  56       else do
  57         warn verbosity $
  58           "Your version of HPC ("
  59             ++ prettyShow hpcVer
  60             ++ ") does not properly handle multiple search paths. "
  61             ++ "Coverage report generation may fail unexpectedly. These "
  62             ++ "issues are addressed in version 0.7 or later (GHC 7.8 or "
  63             ++ "later)."
  64             ++ if null droppedDirs
  65               then ""
  66               else
  67                 " The following search paths have been abandoned: "
  68                   ++ show droppedDirs
  69         return passedDirs
  70
  71   -- Prior to GHC 8.0, hpc assumes all .mix paths are relative.
  72   hpcDirs'' <- traverse makeRelativeToCurrentDirectory hpcDirs'
  73
  74   runProgramInvocation
  75     verbosity
  76     (markupInvocation hpc tixFile hpcDirs'' destDir included)
  77   where
  78     version07 = mkVersion [0, 7]
  79     (passedDirs, droppedDirs) = splitAt 1 hpcDirs
  80
  81 markupInvocation
  82   :: ConfiguredProgram
  83   -> FilePath
  84   -- ^ Path to .tix file
  85   -> [FilePath]
  86   -- ^ Paths to .mix file directories
  87   -> FilePath
  88   -- ^ Path where html output should be
  89   -- located
  90   -> [ModuleName]
  91   -- ^ List of modules to include
  92   -> ProgramInvocation
  93 markupInvocation hpc tixFile hpcDirs destDir included =
  94   let args =
  95         [ "markup"
  96         , tixFile
  97         , "--destdir=" ++ destDir
  98         ]
  99           ++ map ("--hpcdir=" ++) hpcDirs
 100           ++ [ "--include=" ++ prettyShow moduleName
 101              | moduleName <- included
 102              ]
 103    in programInvocation hpc args
 104
 105 union
 106   :: ConfiguredProgram
 107   -> Verbosity
 108   -> [FilePath]
 109   -- ^ Paths to .tix files
 110   -> FilePath
 111   -- ^ Path to resultant .tix file
 112   -> [ModuleName]
 113   -- ^ List of modules to exclude from union
 114   -> IO ()
 115 union hpc verbosity tixFiles outFile excluded =
 116   runProgramInvocation
 117     verbosity
 118     (unionInvocation hpc tixFiles outFile excluded)
 119
 120 unionInvocation
 121   :: ConfiguredProgram
 122   -> [FilePath]
 123   -- ^ Paths to .tix files
 124   -> FilePath
 125   -- ^ Path to resultant .tix file
 126   -> [ModuleName]
 127   -- ^ List of modules to exclude from union
 128   -> ProgramInvocation
 129 unionInvocation hpc tixFiles outFile excluded =
 130   programInvocation hpc $
 131     concat
 132       [ ["sum", "--union"]
 133       , tixFiles
 134       , ["--output=" ++ outFile]
 135       , [ "--exclude=" ++ prettyShow moduleName
 136         | moduleName <- excluded
 137         ]
 138       ]