{-# OPTIONS_HADDOCK hide #-}
-- |
-- Module:     Trace.Hpc.Codecov.Options
-- Copyright:  (c) 2022 8c6794b6
-- License:    BSD3
-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>
--
-- Command line options for generating Codecov test coverage report.

module Trace.Hpc.Codecov.Options
  (
    -- * The Options type and predefined values
    Options(..)
  , defaultOptions
  , emptyOptions

    -- * Command line parser for 'Options'
  , parseOptions

    -- * Converter
  , opt2rpt

    -- * Help message and version number
  , printHelp
  , printVersion
  , printNumericVersion
  ) where

-- base
import Control.Exception           (throw, throwIO)
import Data.Version                (showVersion)
import System.Console.GetOpt       (ArgDescr (..), ArgOrder (..),
                                    OptDescr (..), getOpt, usageInfo)
import System.Environment          (getProgName)
import System.IO                   (hIsTerminalDevice, stdout)

-- directory
import System.Directory            (doesFileExist)


-- Internal
import Paths_hpc_codecov           (version)
import Trace.Hpc.Codecov.Discover
import Trace.Hpc.Codecov.Exception
import Trace.Hpc.Codecov.Report

-- | Options for generating test coverage report.
data Options = Options
  { Options -> FilePath
optTix         :: FilePath
    -- ^ Input tix file.
  , Options -> [FilePath]
optMixDirs     :: [FilePath]
    -- ^ Directory containing mix files referred by the tix file.
  , Options -> [FilePath]
optSrcDirs     :: [FilePath]
    -- ^ Directory containing source codes referred by the mix files.
  , Options -> [FilePath]
optExcludes    :: [String]
    -- ^ Module name strings to exclude from coverage report.
  , Options -> Maybe FilePath
optOutFile     :: Maybe FilePath
    -- ^ Output file to write JSON report, if given.

  , Options -> FilePath
optFormat      :: String
    -- ^ Format of generated report.

  , Options -> Bool
optVerbose     :: Bool
    -- ^ Flag for showing verbose message during coverage report
    -- generation.

  , Options -> FilePath
optRootDir     :: FilePath
    -- ^ Project root directory for the build tool.
  , Options -> Maybe FilePath
optBuildDir    :: Maybe FilePath
    -- ^ Name of the build directory used by the build tool
  , Options -> [FilePath]
optSkipDirs    :: [String]
    -- ^ Directories to ignore while discovering.

  , Options -> Bool
optShowVersion :: Bool
    -- ^ Flag for showing version.
  , Options -> Bool
optShowNumeric :: Bool
    -- ^ Flag for showing numeric version.
  , Options -> Bool
optShowHelp    :: Bool
    -- ^ Flag for showing help message.
  }

-- | Empty 'Options'.
emptyOptions :: Options
emptyOptions :: Options
emptyOptions = Options
  { optTix :: FilePath
optTix = forall a e. Exception e => e -> a
throw HpcCodecovError
NoTarget
  , optMixDirs :: [FilePath]
optMixDirs = []
  , optSrcDirs :: [FilePath]
optSrcDirs = []
  , optExcludes :: [FilePath]
optExcludes = []
  , optOutFile :: Maybe FilePath
optOutFile = forall a. Maybe a
Nothing
  , optFormat :: FilePath
optFormat = FilePath
"codecov"
  , optVerbose :: Bool
optVerbose = Bool
False
  , optRootDir :: FilePath
optRootDir = FilePath
""
  , optBuildDir :: Maybe FilePath
optBuildDir = forall a. Maybe a
Nothing
  , optSkipDirs :: [FilePath]
optSkipDirs = []
  , optShowVersion :: Bool
optShowVersion = Bool
False
  , optShowNumeric :: Bool
optShowNumeric = Bool
False
  , optShowHelp :: Bool
optShowHelp = Bool
False
  }

-- | The default 'Options'.
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
emptyOptions
  { optMixDirs :: [FilePath]
optMixDirs = [FilePath
".hpc"]
  , optSrcDirs :: [FilePath]
optSrcDirs = [FilePath
""]
  }

-- | Commandline option oracle.
options :: [OptDescr (Options -> Options)]
options :: [OptDescr (Options -> Options)]
options =
  [ forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'm'] [FilePath
"mix"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
d Options
o -> Options
o {optMixDirs :: [FilePath]
optMixDirs = FilePath -> [FilePath]
uncommas FilePath
d forall a. [a] -> [a] -> [a]
++ Options -> [FilePath]
optMixDirs Options
o})
                   FilePath
"DIR")
            FilePath
".mix file directory, can repeat\n\
            \(default: .hpc)"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
's'] [FilePath
"src"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
d Options
o -> Options
o {optSrcDirs :: [FilePath]
optSrcDirs = FilePath -> [FilePath]
uncommas FilePath
d forall a. [a] -> [a] -> [a]
++ Options -> [FilePath]
optSrcDirs Options
o})
                   FilePath
"DIR")
           FilePath
"Source directory, can repeat\n\
           \(default: current directory)"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'x'] [FilePath
"exclude"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
m Options
o -> Options
o {optExcludes :: [FilePath]
optExcludes = FilePath -> [FilePath]
uncommas FilePath
m forall a. [a] -> [a] -> [a]
++ Options -> [FilePath]
optExcludes Options
o})
                   FilePath
"MODULE")
           FilePath
"Module name to exclude, can repeat"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'o'] [FilePath
"out"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
p Options
o -> Options
o {optOutFile :: Maybe FilePath
optOutFile = forall a. a -> Maybe a
Just FilePath
p}) FilePath
"FILE")
           FilePath
"Output file\n\
           \(default: stdout)"

  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'r'] [FilePath
"root"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
d Options
o -> Options
o {optRootDir :: FilePath
optRootDir = FilePath
d})
                   FilePath
"DIR")
           FilePath
"Project root directory for TOOL\n\
           \Usually the directory containing\n\
           \'stack.yaml' or 'cabal.project'\n\
           \(default: current directory)"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'b'] [FilePath
"build"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
d Options
o -> Options
o {optBuildDir :: Maybe FilePath
optBuildDir = forall a. a -> Maybe a
Just FilePath
d})
                   FilePath
"DIR")
           FilePath
"Build directory made by the TOOL\n\
           \(default:\n\
           \ - '.stack-work' for stack\n\
           \ - 'dist-newstyle' for cabal)"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'X'] [FilePath
"skip"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
d Options
o -> Options
o {optSkipDirs :: [FilePath]
optSkipDirs = FilePath -> [FilePath]
uncommas FilePath
d forall a. [a] -> [a] -> [a]
++ Options -> [FilePath]
optSkipDirs Options
o})
                   FilePath
"DIR")
           FilePath
"Basename of directory to skip while\n\
           \searching data for TOOL, can repeat"

  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'f'] [FilePath
"format"]
           (forall a. (FilePath -> a) -> FilePath -> ArgDescr a
ReqArg (\FilePath
s Options
o -> Options
o {optFormat :: FilePath
optFormat = FilePath
s})
                   FilePath
"FMT")
           FilePath
"Format of generated report\n\
           \'codecov', 'lcov', or 'cobertura'\n\
           \(default: codecov)"

  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'v'] [FilePath
"verbose"]
           (forall a. a -> ArgDescr a
NoArg (\Options
o -> Options
o {optVerbose :: Bool
optVerbose = Bool
True}))
           FilePath
"Show verbose output"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [] [FilePath
"version"]
           (forall a. a -> ArgDescr a
NoArg (\Options
o -> Options
o {optShowVersion :: Bool
optShowVersion = Bool
True}))
           FilePath
"Show versoin and exit"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [] [FilePath
"numeric-version"]
           (forall a. a -> ArgDescr a
NoArg (\Options
o -> Options
o {optShowNumeric :: Bool
optShowNumeric = Bool
True}))
           FilePath
"Show numeric version and exit"
  , forall a.
FilePath -> [FilePath] -> ArgDescr a -> FilePath -> OptDescr a
Option [Char
'h'] [FilePath
"help"]
           (forall a. a -> ArgDescr a
NoArg (\Options
o -> Options
o {optShowHelp :: Bool
optShowHelp = Bool
True}))
           FilePath
"Show this help and exit"
  ]

-- | Parse command line argument and return either error messages or
-- parsed 'Options'.
parseOptions :: [String] -- ^ Command line argument strings.
             -> Either [String] Options
parseOptions :: [FilePath] -> Either [FilePath] Options
parseOptions [FilePath]
args =
  case forall a.
ArgOrder a
-> [OptDescr a] -> [FilePath] -> ([a], [FilePath], [FilePath])
getOpt forall a. ArgOrder a
Permute [OptDescr (Options -> Options)]
options [FilePath]
args of
    ([Options -> Options]
flags, [FilePath]
rest, []) ->
      -- Not returning error messages with missing ".tix" file
      -- argument at this point, to show help and version messages
      -- without specifying ".tix" file.
      let opts0 :: Options
opts0 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
($) Options
emptyOptions [Options -> Options]
flags
          opts1 :: Options
opts1 = Options -> Options
fillDefaultIfNotGiven Options
opts0
      in  case [FilePath]
rest of
            []      -> forall a b. b -> Either a b
Right Options
opts1
            (FilePath
tix:[FilePath]
_) -> forall a b. b -> Either a b
Right (Options
opts1 {optTix :: FilePath
optTix = FilePath
tix})
    ([Options -> Options]
_, [FilePath]
_, [FilePath]
errs)  -> forall a b. a -> Either a b
Left [FilePath]
errs

fillDefaultIfNotGiven :: Options -> Options
fillDefaultIfNotGiven :: Options -> Options
fillDefaultIfNotGiven Options
opts = Options
opts
  { optMixDirs :: [FilePath]
optMixDirs = forall {t}. (t -> Bool) -> (Options -> t) -> t
fillIf forall (t :: * -> *) a. Foldable t => t a -> Bool
null Options -> [FilePath]
optMixDirs
  , optSrcDirs :: [FilePath]
optSrcDirs = forall {t}. (t -> Bool) -> (Options -> t) -> t
fillIf forall (t :: * -> *) a. Foldable t => t a -> Bool
null Options -> [FilePath]
optSrcDirs
  }
 where
   fillIf :: (t -> Bool) -> (Options -> t) -> t
fillIf t -> Bool
test Options -> t
fld =
      let orig :: t
orig = Options -> t
fld Options
opts
      in  if t -> Bool
test t
orig
             then Options -> t
fld Options
defaultOptions
             else t
orig

-- | Representation of @TARGET@ argument.
data Target
  = TixFile FilePath
  | TestSuite BuildTool String

parseTarget :: String -> IO Target
parseTarget :: FilePath -> IO Target
parseTarget FilePath
str = do
  -- Detecting file existence before separating with ':', to support
  -- directory path containing ':' under Windows.
  Bool
file_found <- FilePath -> IO Bool
doesFileExist FilePath
str
  if Bool
file_found
     then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Target
TixFile FilePath
str
     else case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
':') FilePath
str of
       (FilePath
"cabal", Char
':':FilePath
name) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BuildTool -> FilePath -> Target
TestSuite BuildTool
Cabal FilePath
name
       (FilePath
"stack", Char
':':FilePath
name) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ BuildTool -> FilePath -> Target
TestSuite BuildTool
Stack FilePath
name
       (FilePath
tool, Char
':':FilePath
_)       -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> HpcCodecovError
InvalidBuildTool FilePath
tool
       (FilePath, FilePath)
_                   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FilePath -> Target
TixFile FilePath
str

parseFormat :: String -> IO Format
parseFormat :: FilePath -> IO Format
parseFormat FilePath
fmt = case FilePath
fmt of
  FilePath
"codecov"   -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
Codecov
  FilePath
"lcov"      -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
Lcov
  FilePath
"cobertura" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Format
Cobertura
  FilePath
_           -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ FilePath -> HpcCodecovError
InvalidFormat FilePath
fmt

uncommas :: String -> [String]
uncommas :: FilePath -> [FilePath]
uncommas = FilePath -> [FilePath]
go
  where
    go :: FilePath -> [FilePath]
go FilePath
str = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
',') FilePath
str of
      (FilePath
cs, Char
',':FilePath
rest) -> FilePath
cs forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
go FilePath
rest
      (FilePath
cs, FilePath
_)        -> [FilePath
cs]

-- | Make a 'Report' value from 'Optoins'.
opt2rpt :: Options -> IO Report
opt2rpt :: Options -> IO Report
opt2rpt Options
opt = do
  let rpt1 :: Report
rpt1 = forall a. Monoid a => a
mempty
        { reportMixDirs :: [FilePath]
reportMixDirs = Options -> [FilePath]
optMixDirs Options
opt
        , reportSrcDirs :: [FilePath]
reportSrcDirs = Options -> [FilePath]
optSrcDirs Options
opt
        , reportExcludes :: [FilePath]
reportExcludes = Options -> [FilePath]
optExcludes Options
opt
        , reportOutFile :: Maybe FilePath
reportOutFile = Options -> Maybe FilePath
optOutFile Options
opt
        , reportVerbose :: Bool
reportVerbose = Bool
verbose
        }
      tix :: FilePath
tix = Options -> FilePath
optTix Options
opt
      verbose :: Bool
verbose = Options -> Bool
optVerbose Options
opt
  Format
format <- FilePath -> IO Format
parseFormat (Options -> FilePath
optFormat Options
opt)
  Target
target <- FilePath -> IO Target
parseTarget FilePath
tix
  case Target
target of
    TixFile FilePath
path -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Report
rpt1 {reportTix :: FilePath
reportTix = FilePath
path
                               ,reportFormat :: Format
reportFormat = Format
format})
    TestSuite BuildTool
tool FilePath
name -> do
      Report
rpt2 <- DiscoverArgs -> IO Report
discover DiscoverArgs
        { da_tool :: BuildTool
da_tool = BuildTool
tool
        , da_testsuite :: FilePath
da_testsuite = FilePath
name
        , da_rootdir :: FilePath
da_rootdir = Options -> FilePath
optRootDir Options
opt
        , da_builddir :: Maybe FilePath
da_builddir = Options -> Maybe FilePath
optBuildDir Options
opt
        , da_skipdirs :: [FilePath]
da_skipdirs = Options -> [FilePath]
optSkipDirs Options
opt
        , da_verbose :: Bool
da_verbose = Bool
verbose
        }
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Report
rpt1 forall a. Monoid a => a -> a -> a
`mappend` Report
rpt2 {reportFormat :: Format
reportFormat = Format
format}

-- | Print help messages.
printHelp :: IO ()
printHelp :: IO ()
printHelp = do
  FilePath
me <- IO FilePath
getProgName
  Bool
is_terminal <- Handle -> IO Bool
hIsTerminalDevice Handle
stdout
  FilePath -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> FilePath
helpMessage Bool
is_terminal FilePath
me

-- | Print version number of this package.
printVersion :: IO ()
printVersion :: IO ()
printVersion = do
  FilePath
me <- IO FilePath
getProgName
  FilePath -> IO ()
putStrLn (FilePath
me forall a. [a] -> [a] -> [a]
++ FilePath
" version " forall a. [a] -> [a] -> [a]
++ FilePath
versionString)

-- | Print numeriv version number of this package.
printNumericVersion :: IO ()
printNumericVersion :: IO ()
printNumericVersion = FilePath -> IO ()
putStrLn FilePath
versionString

boldUnderline :: Bool -> String -> String
boldUnderline :: Bool -> FilePath -> FilePath
boldUnderline Bool
is_terminal FilePath
str
  | Bool
is_terminal = FilePath
"\ESC[1m\ESC[4m" forall a. [a] -> [a] -> [a]
++ FilePath
str forall a. [a] -> [a] -> [a]
++ FilePath
"\ESC[0m"
  | Bool
otherwise = FilePath
str

bold :: Bool -> String -> String
bold :: Bool -> FilePath -> FilePath
bold Bool
is_terminal FilePath
str
  | Bool
is_terminal = FilePath
"\ESC[1m" forall a. [a] -> [a] -> [a]
++ FilePath
str forall a. [a] -> [a] -> [a]
++ FilePath
"\ESC[0m"
  | Bool
otherwise = FilePath
str

-- | Help message for command line output.
helpMessage :: Bool -- ^ 'True' when showing in a terminal.
            -> String -- ^ Executable program name.
            -> String
helpMessage :: Bool -> FilePath -> FilePath
helpMessage Bool
is_terminal FilePath
name = forall a. FilePath -> [OptDescr a] -> FilePath
usageInfo FilePath
header [OptDescr (Options -> Options)]
options forall a. [a] -> [a] -> [a]
++ FilePath
footer
  where
    b :: FilePath -> FilePath
b = Bool -> FilePath -> FilePath
bold Bool
is_terminal
    bu :: FilePath -> FilePath
bu = Bool -> FilePath -> FilePath
boldUnderline Bool
is_terminal
    header :: FilePath
header = FilePath
"A tool to generate reports from .tix and .mix files\n\
\\n\
\" forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
bu FilePath
"USAGE:" forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
b FilePath
name forall a. [a] -> [a] -> [a]
++ FilePath
" [OPTIONS] TARGET\n\
\\n\
\" forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
bu FilePath
"ARGUMENTS:" forall a. [a] -> [a] -> [a]
++ FilePath
"\n\
\  <TARGET>  Either a path to a .tix file or a 'TOOL:TEST_SUITE'.\n\
\            Supported TOOL values are 'stack' and 'cabal'.\n\
\            When the TOOL is 'stack' and building a project with\n\
\            multiple packages, use 'all' as the TEST_SUITE value\n\
\            to specify the combined report.\n\
\\n\
\" forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
bu FilePath
"OPTIONS:"
    footer :: FilePath
footer = FilePath
"\
\\n\
\For more info, see:\n\
\\n\
\  https://github.com/8c6794b6/hpc-codecov#readme\n\
\"

-- | String representation of the version number of this package.
versionString :: String
versionString :: FilePath
versionString = Version -> FilePath
showVersion Version
version