-- |
-- Module:     Trace.Hpc.Codecov.Exception
-- Copyright:  (c) 2020 8c6794b6
-- License:    BSD3
-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>
--
-- Error and exception related codes.

module Trace.Hpc.Codecov.Exception
  (
    -- * Exception data type and handler
    HpcCodecovError(..)
  , withBriefUsageOnError
  ) where

-- base
import Control.Exception  (Exception (..), handle)
import System.Environment (getProgName)
import System.Exit        (exitFailure)

-- | Run the given action with a handler for 'HpcCodecovError'.
--
-- The handler will show a brief usage and call 'exitFailure' when an
-- exception was caught.
withBriefUsageOnError :: IO a   -- ^ Action to perform.
                      -> IO a
withBriefUsageOnError :: IO a -> IO a
withBriefUsageOnError = (HpcCodecovError -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle HpcCodecovError -> IO a
forall a. HpcCodecovError -> IO a
handler
  where
    handler :: HpcCodecovError -> IO a
    handler :: HpcCodecovError -> IO a
handler HpcCodecovError
e =
      do String -> IO ()
putStr (String
"Error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ HpcCodecovError -> String
forall e. Exception e => e -> String
displayException HpcCodecovError
e)
         String
name <- IO String
getProgName
         String -> IO ()
putStrLn (String
"Run '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" --help' for usage.")
         IO a
forall a. IO a
exitFailure

-- | Exceptions thrown during coverage report generation.
data HpcCodecovError
  = NoTarget
   -- ^ Target was not given.
  | TixNotFound FilePath
   -- ^ Tix file path was given, but not found.
  | MixNotFound FilePath [FilePath]
   -- ^ Mix file not found. The first field is the path specified by a
   -- tix file. The second is the searched paths.
  | SrcNotFound FilePath [FilePath]
   -- ^ Like 'MixNotFound', but for source code specified by a mix
   -- file.
  | InvalidBuildTool String
   -- ^ Invalid build tool.
  | TestSuiteNotFound String
   -- ^ Test suite was given, but not found.
  | InvalidArgs [String]
   -- ^ Some errors in command line argument, e.g., required value not
   -- specified.
  deriving (Int -> HpcCodecovError -> String -> String
[HpcCodecovError] -> String -> String
HpcCodecovError -> String
(Int -> HpcCodecovError -> String -> String)
-> (HpcCodecovError -> String)
-> ([HpcCodecovError] -> String -> String)
-> Show HpcCodecovError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [HpcCodecovError] -> String -> String
$cshowList :: [HpcCodecovError] -> String -> String
show :: HpcCodecovError -> String
$cshow :: HpcCodecovError -> String
showsPrec :: Int -> HpcCodecovError -> String -> String
$cshowsPrec :: Int -> HpcCodecovError -> String -> String
Show)

instance Exception HpcCodecovError where
  displayException :: HpcCodecovError -> String
displayException = HpcCodecovError -> String
hpcCodecovErrorMessage

hpcCodecovErrorMessage :: HpcCodecovError -> String
hpcCodecovErrorMessage :: HpcCodecovError -> String
hpcCodecovErrorMessage HpcCodecovError
e =
  case HpcCodecovError
e of
    HpcCodecovError
NoTarget -> String
"no TARGET was given\n"
    TixNotFound String
tix -> String
"cannot find tix: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
tix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    MixNotFound String
mix [String]
locs -> String -> String -> [String] -> String
searchedLocations String
"mix" String
mix [String]
locs
    SrcNotFound String
src [String]
locs -> String -> String -> [String] -> String
searchedLocations String
"src" String
src [String]
locs
    InvalidBuildTool String
tool-> String
"invalid build tool: `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
tool String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'\n"
    TestSuiteNotFound String
name ->
      String
"cannot find tix for test suite: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    InvalidArgs [String]
msgs ->
      case [String]
msgs of
        [String
x] -> String
x
        [String]
_   -> Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String
"  - " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
msgs

searchedLocations :: String -> FilePath -> [FilePath] -> String
searchedLocations :: String -> String -> [String] -> String
searchedLocations String
what String
path [String]
locs =
  String
"cannot find " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
what String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
path String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
locs'
  where
    locs' :: String
locs' =
      case [String]
locs of
       [String
_] -> String -> String
searched String
""
       [String]
_   -> String -> String
searched String
"s"
    searched :: String -> String
searched String
post =
      String
"\nsearched location" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
post String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
      [String] -> String
unlines ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
locs)