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

module Trace.Hpc.Codecov.Exception
  (
    -- * Exception data type
    HpcCodecovError(..)
  ) where

-- base
import Control.Exception (Exception (..))

-- | 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.
  | InvalidFormat String
   -- ^ Invalid report format.
  | 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 -> ShowS
[HpcCodecovError] -> ShowS
HpcCodecovError -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [HpcCodecovError] -> ShowS
$cshowList :: [HpcCodecovError] -> ShowS
show :: HpcCodecovError -> FilePath
$cshow :: HpcCodecovError -> FilePath
showsPrec :: Int -> HpcCodecovError -> ShowS
$cshowsPrec :: Int -> HpcCodecovError -> ShowS
Show)

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

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

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