-- |
-- Module:     Trace.Hpc.Codecov.Report.Entry
-- Copyright:  (c) 2023 8c6794b6
-- License:    BSD3
-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>
--
-- Codes for converting tix and mix files to 'CoverageEntry'.

module Trace.Hpc.Codecov.Report.Entry
  ( Report(..)
  , CoverageEntry(..)
  , Format(..)
  , LineHits
  , Hit(..)
  , FunctionHits
  , BranchHits
  , tixToCoverage
  , readTixFile
  ) where

-- base
import           Control.Applicative         ((<|>))
import           Control.Exception           (ErrorCall, handle, throw,
                                              throwIO)
import           Control.Monad               (when)
import           Control.Monad.ST            (ST)
import           Data.Function               (on)
import           Data.List                   (foldl', intercalate)
import           System.IO                   (hPutStrLn, stderr)

-- array
import           Data.Array.Base             (unsafeAt)
import           Data.Array.IArray           (assocs, listArray)
import           Data.Array.MArray           (newArray, readArray,
                                              writeArray)
import           Data.Array.ST               (STArray, runSTArray)
import           Data.Array.Unboxed          (UArray)

-- containers
import qualified Data.IntMap                 as IntMap

-- directory
import           System.Directory            (doesFileExist)

-- filepath
import           System.FilePath             ((<.>), (</>))

-- hpc
import           Trace.Hpc.Mix               (BoxLabel (..), Mix (..),
                                              MixEntry)
import           Trace.Hpc.Tix               (Tix (..), TixModule (..))
import           Trace.Hpc.Util              (fromHpcPos)


-- Internal
import           Trace.Hpc.Codecov.Exception
import           Trace.Hpc.Codecov.Parser


-- ------------------------------------------------------------------------
--
-- Types
--
-- ------------------------------------------------------------------------

-- | Data type to hold information for generating test coverage
-- report.
data Report = Report
 { Report -> FilePath
reportTix      :: FilePath
   -- ^ Input tix file.
 , Report -> [FilePath]
reportMixDirs  :: [FilePath]
   -- ^ Directories containing mix files referred by the tix file.
 , Report -> [FilePath]
reportSrcDirs  :: [FilePath]
   -- ^ Directories containing source codes referred by the mix files.
 , Report -> [FilePath]
reportExcludes :: [String]
   -- ^ Module name strings to exclude from coverage report.
 , Report -> Maybe FilePath
reportOutFile  :: Maybe FilePath
   -- ^ Output file to write report data, if given.
 , Report -> Bool
reportVerbose  :: Bool
   -- ^ Flag for showing verbose message during report generation.
 , Report -> Format
reportFormat   :: Format
   -- ^ Format of the report output.
   --
   -- @since 0.4.0.0
 } deriving (Report -> Report -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Report -> Report -> Bool
$c/= :: Report -> Report -> Bool
== :: Report -> Report -> Bool
$c== :: Report -> Report -> Bool
Eq, Tick -> Report -> ShowS
[Report] -> ShowS
Report -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> FilePath
$cshow :: Report -> FilePath
showsPrec :: Tick -> Report -> ShowS
$cshowsPrec :: Tick -> Report -> ShowS
Show)

instance Semigroup Report where
  <> :: Report -> Report -> Report
(<>) = Report -> Report -> Report
mappendReport

instance Monoid Report where
  mempty :: Report
mempty = Report
emptyReport

emptyReport :: Report
emptyReport :: Report
emptyReport = Report
  { reportTix :: FilePath
reportTix = forall a e. Exception e => e -> a
throw HpcCodecovError
NoTarget
  , reportMixDirs :: [FilePath]
reportMixDirs = []
  , reportSrcDirs :: [FilePath]
reportSrcDirs = []
  , reportExcludes :: [FilePath]
reportExcludes = []
  , reportOutFile :: Maybe FilePath
reportOutFile = forall a. Maybe a
Nothing
  , reportVerbose :: Bool
reportVerbose = Bool
False
  , reportFormat :: Format
reportFormat = Format
Codecov
  }

mappendReport :: Report -> Report -> Report
mappendReport :: Report -> Report -> Report
mappendReport Report
r1 Report
r2 =
  let extend :: (b -> b -> c) -> (Report -> b) -> c
extend b -> b -> c
f Report -> b
g = (b -> b -> c
f forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Report -> b
g) Report
r1 Report
r2
  in  Report { reportTix :: FilePath
reportTix = Report -> FilePath
reportTix Report
r2
             , reportMixDirs :: [FilePath]
reportMixDirs = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall a. Semigroup a => a -> a -> a
(<>) Report -> [FilePath]
reportMixDirs
             , reportSrcDirs :: [FilePath]
reportSrcDirs = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall a. Semigroup a => a -> a -> a
(<>) Report -> [FilePath]
reportSrcDirs
             , reportExcludes :: [FilePath]
reportExcludes = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall a. Semigroup a => a -> a -> a
(<>) Report -> [FilePath]
reportExcludes
             , reportOutFile :: Maybe FilePath
reportOutFile = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Report -> Maybe FilePath
reportOutFile
             , reportVerbose :: Bool
reportVerbose = forall {b} {c}. (b -> b -> c) -> (Report -> b) -> c
extend Bool -> Bool -> Bool
(||) Report -> Bool
reportVerbose
             , reportFormat :: Format
reportFormat = Report -> Format
reportFormat Report
r2
             }

-- | Single file entry in coverage report.
--
data CoverageEntry =
  CoverageEntry { CoverageEntry -> FilePath
ce_filename :: FilePath -- ^ Source code file name.
                , CoverageEntry -> LineHits
ce_hits     :: LineHits -- ^ Line hits of the file.
                , CoverageEntry -> FunctionHits
ce_fns      :: FunctionHits
                  -- ^ Function hits of the file.
                  --
                  -- @since 0.4.0.0
                , CoverageEntry -> BranchHits
ce_branches :: BranchHits
                  -- ^ Branch hits of the file.
                  --
                  -- @since 0.4.0.0
                } deriving (CoverageEntry -> CoverageEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoverageEntry -> CoverageEntry -> Bool
$c/= :: CoverageEntry -> CoverageEntry -> Bool
== :: CoverageEntry -> CoverageEntry -> Bool
$c== :: CoverageEntry -> CoverageEntry -> Bool
Eq, Tick -> CoverageEntry -> ShowS
[CoverageEntry] -> ShowS
CoverageEntry -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CoverageEntry] -> ShowS
$cshowList :: [CoverageEntry] -> ShowS
show :: CoverageEntry -> FilePath
$cshow :: CoverageEntry -> FilePath
showsPrec :: Tick -> CoverageEntry -> ShowS
$cshowsPrec :: Tick -> CoverageEntry -> ShowS
Show)

-- | Pair of line number and hit tag.
type LineHits = [(Int, Hit)]

-- | Data type to represent coverage of source code line.
--
-- The 'Int' value in 'Partial' and 'Full' are the hit count.
data Hit
  = Missed  -- ^ The line is not covered at all.
  | Partial Int -- ^ The line is partially covered.
  | Full Int   -- ^ The line is fully covered.
  deriving (Hit -> Hit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hit -> Hit -> Bool
$c/= :: Hit -> Hit -> Bool
== :: Hit -> Hit -> Bool
$c== :: Hit -> Hit -> Bool
Eq, Tick -> Hit -> ShowS
[Hit] -> ShowS
Hit -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Hit] -> ShowS
$cshowList :: [Hit] -> ShowS
show :: Hit -> FilePath
$cshow :: Hit -> FilePath
showsPrec :: Tick -> Hit -> ShowS
$cshowsPrec :: Tick -> Hit -> ShowS
Show)

-- | Type synonym for tracking function enter count. Elements are
-- start line number, end line number, execution count, and function
-- name.
--
-- @since 0.4.0.0
type FunctionHits = [(Int, Int, Int, String)]

-- | Type synonym for tracking branch information. Elements are start
-- line number, branch block number, 'Bool' for the taken branch, and
-- execution count.
--
-- @since 0.4.0.0
type BranchHits = [(Int, Int, Bool, Int)]

-- | Data type for generated report format.
data Format
  = Codecov
  -- ^ Custom Codecov JSON format. See the
  -- <https://docs.codecov.io/docs/codecov-custom-coverage-format Codecov documentation>
  -- for detail.
  --
  -- @since 0.1.0.0
  | Lcov
  -- ^ LCOV tracefile format. See the
  -- <https://ltp.sourceforge.net/coverage/lcov/geninfo.1.php geninfo manpage>
  -- for detail.
  --
  -- @since 0.4.0.0
  | Cobertura
  -- ^ Cobertura XML file format. See the
  -- <https://cobertura.github.io/cobertura/ Cobertura> website for detail.
  --
  -- @since 0.5.0.0
  deriving (Format -> Format -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Format -> Format -> Bool
$c/= :: Format -> Format -> Bool
== :: Format -> Format -> Bool
$c== :: Format -> Format -> Bool
Eq, Tick -> Format -> ShowS
[Format] -> ShowS
Format -> FilePath
forall a.
(Tick -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Format] -> ShowS
$cshowList :: [Format] -> ShowS
show :: Format -> FilePath
$cshow :: Format -> FilePath
showsPrec :: Tick -> Format -> ShowS
$cshowsPrec :: Tick -> Format -> ShowS
Show)


-- ------------------------------------------------------------------------
--
-- Tix to CoverageEntry
--
-- ------------------------------------------------------------------------

tixToCoverage :: Report -> Tix -> IO [CoverageEntry]
tixToCoverage :: Report -> Tix -> IO [CoverageEntry]
tixToCoverage Report
rpt (Tix [TixModule]
tms) =
  forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Report -> TixModule -> IO CoverageEntry
tixModuleToCoverage Report
rpt) (Report -> [TixModule] -> [TixModule]
excludeModules Report
rpt [TixModule]
tms)

tixModuleToCoverage :: Report -> TixModule -> IO CoverageEntry
tixModuleToCoverage :: Report -> TixModule -> IO CoverageEntry
tixModuleToCoverage Report
rpt tm :: TixModule
tm@(TixModule FilePath
name Hash
_hash Tick
count [Integer]
ixs) = do
  Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Searching mix:  " forall a. [a] -> [a] -> [a]
++ FilePath
name)
  Mix FilePath
path UTCTime
_ Hash
_ Tick
_ [MixEntry]
entries <- [FilePath] -> TixModule -> IO Mix
readMixFile (Report -> [FilePath]
reportMixDirs Report
rpt) TixModule
tm
  Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found mix:      " forall a. [a] -> [a] -> [a]
++ FilePath
path)
  let Info Tick
_ Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
hits FunctionHits
fns PreBranchHits
pre_brs = Tick -> [Integer] -> [MixEntry] -> Info
makeInfo Tick
count [Integer]
ixs [MixEntry]
entries
      lineHits :: LineHits
lineHits = Tick -> Tick -> [(Tick, Tick, Tick)] -> LineHits
makeLineHits Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
hits
  FilePath
path' <- Report -> FilePath -> IO FilePath
ensureSrcPath Report
rpt FilePath
path
  forall (m :: * -> *) a. Monad m => a -> m a
return (CoverageEntry { ce_filename :: FilePath
ce_filename = FilePath
path'
                        , ce_hits :: LineHits
ce_hits = LineHits
lineHits
                        , ce_fns :: FunctionHits
ce_fns = FunctionHits
fns
                        , ce_branches :: BranchHits
ce_branches = PreBranchHits -> BranchHits
reBranch PreBranchHits
pre_brs })

-- | Exclude modules specified in given 'Report'.
excludeModules :: Report -> [TixModule] -> [TixModule]
excludeModules :: Report -> [TixModule] -> [TixModule]
excludeModules Report
rpt = forall a. (a -> Bool) -> [a] -> [a]
filter TixModule -> Bool
exclude
  where
    exclude :: TixModule -> Bool
exclude (TixModule FilePath
pkg_slash_name Hash
_ Tick
_ [Integer]
_) =
      let modname :: FilePath
modname = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
pkg_slash_name of
                      (FilePath
_, Char
'/':FilePath
name) -> FilePath
name
                      (FilePath
name, FilePath
_)     -> FilePath
name
      in  forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
notElem FilePath
modname (Report -> [FilePath]
reportExcludes Report
rpt)

-- | Read tix file from file path, return a 'Tix' data or throw
-- a 'TixNotFound' exception.
readTixFile :: Report -> FilePath -> IO Tix
readTixFile :: Report -> FilePath -> IO Tix
readTixFile Report
rpt FilePath
path = do
  Maybe Tix
mb_tix <- {-# SCC "readTixFile.readTix'" #-} FilePath -> IO (Maybe Tix)
readTix' FilePath
path
  case Maybe Tix
mb_tix of
    Maybe Tix
Nothing  -> forall e a. Exception e => e -> IO a
throwIO (FilePath -> HpcCodecovError
TixNotFound FilePath
path)
    Just Tix
tix -> Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found tix file: " forall a. [a] -> [a] -> [a]
++ FilePath
path) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Tix
tix

-- | Search mix file under given directories, return a 'Mix' data or
-- throw a 'MixNotFound' exception.
readMixFile :: [FilePath] -> TixModule -> IO Mix
readMixFile :: [FilePath] -> TixModule -> IO Mix
readMixFile [FilePath]
dirs tm :: TixModule
tm@(TixModule FilePath
name Hash
_h Tick
_c [Integer]
_i) = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. ErrorCall -> IO a
handler IO Mix
go
  where
    handler :: ErrorCall -> IO a
    handler :: forall a. ErrorCall -> IO a
handler ErrorCall
_ = forall e a. Exception e => e -> IO a
throwIO (FilePath -> [FilePath] -> HpcCodecovError
MixNotFound FilePath
name [FilePath]
dirs')
    dirs' :: [FilePath]
dirs' = forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
</> (FilePath
name FilePath -> ShowS
<.> FilePath
"mix")) [FilePath]
dirs
    go :: IO Mix
go = {-# SCC "readMixFile.readMix'" #-} [FilePath] -> Either FilePath TixModule -> IO Mix
readMix' [FilePath]
dirs (forall a b. b -> Either a b
Right TixModule
tm)

-- | Ensure the given source file exist, return the ensured 'FilePath'
-- or throw a 'SrcNotFound' exception.
ensureSrcPath :: Report -> FilePath -> IO FilePath
ensureSrcPath :: Report -> FilePath -> IO FilePath
ensureSrcPath Report
rpt FilePath
path = [FilePath] -> [FilePath] -> IO FilePath
go [] (Report -> [FilePath]
reportSrcDirs Report
rpt)
  where
    go :: [FilePath] -> [FilePath] -> IO FilePath
go [FilePath]
acc [] = forall e a. Exception e => e -> IO a
throwIO (FilePath -> [FilePath] -> HpcCodecovError
SrcNotFound FilePath
path [FilePath]
acc)
    go [FilePath]
acc (FilePath
dir:[FilePath]
dirs) = do
      let path' :: FilePath
path' = FilePath
dir FilePath -> ShowS
</> FilePath
path
      Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
path'
      if Bool
exist
        then Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found source:   " forall a. [a] -> [a] -> [a]
++ FilePath
path') forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path'
        else [FilePath] -> [FilePath] -> IO FilePath
go (FilePath
path'forall a. a -> [a] -> [a]
:[FilePath]
acc) [FilePath]
dirs

-- | Arrange branch hit information.
--
-- LCOV tracefile seems like want to have a true branch before the
-- corresponding false branch, so arranging the order.
--
-- Also assigning sequential block numbers to the branch entries
-- starting with identical line number.
reBranch :: PreBranchHits -> BranchHits
reBranch :: PreBranchHits -> BranchHits
reBranch = forall {c} {d}.
IntMap Tick -> [(Tick, c, d)] -> [(Tick, Tick, c, d)]
go forall a. Monoid a => a
mempty
  where
    go :: IntMap Tick -> [(Tick, c, d)] -> [(Tick, Tick, c, d)]
go IntMap Tick
im0 ((Tick
lf,c
brf,d
nf) : (Tick
lt,c
brt,d
nt) : [(Tick, c, d)]
rest) =
      let (Maybe Tick
mb_i, IntMap Tick
im1) = forall a.
(Tick -> a -> a -> a)
-> Tick -> a -> IntMap a -> (Maybe a, IntMap a)
IntMap.insertLookupWithKey forall {p} {p}. p -> p -> Tick -> Tick
f Tick
lf Tick
0 IntMap Tick
im0
          f :: p -> p -> Tick -> Tick
f p
_key p
_new Tick
old = Tick
old forall a. Num a => a -> a -> a
+ Tick
1 :: Int
          i :: Tick
i = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Tick
0 forall a. Enum a => a -> a
succ Maybe Tick
mb_i
      in  (Tick
lt,Tick
i,c
brt,d
nt) forall a. a -> [a] -> [a]
: (Tick
lf,Tick
i,c
brf,d
nf) forall a. a -> [a] -> [a]
: IntMap Tick -> [(Tick, c, d)] -> [(Tick, Tick, c, d)]
go IntMap Tick
im1 [(Tick, c, d)]
rest
    go IntMap Tick
_ [(Tick, c, d)]
_ = []

-- | Print given message to 'stderr' when the verbose flag is 'True'.
say :: Report -> String -> IO ()
say :: Report -> FilePath -> IO ()
say Report
rpt = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Report -> Bool
reportVerbose Report
rpt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr

-- | Internal type synonym to represent code line hit. Using 'Int' so
-- that unboxed arrays can use in its elements.
type Tick = Int

-- | Internal type synonym to represent line hit count.
type Count = Int

-- | Like 'BranchHits', but without branch block number.
type PreBranchHits = [(Int, Bool, Count)]

-- | Internal type used for accumulating mix entries.
data Info =
  Info {-# UNPACK #-} !Int -- ^ Index count
       {-# UNPACK #-} !Int -- ^ Min line number
       {-# UNPACK #-} !Int -- ^ Max line number
       [(Int, Tick, Count)] -- ^ Start line number, tick, and count.
       FunctionHits -- ^ For tracking function.
       PreBranchHits -- ^ For tracking branch.

-- | Make line hits from intermediate info.
makeLineHits :: Int -> Int -> [(Int, Tick, Count)] -> LineHits
makeLineHits :: Tick -> Tick -> [(Tick, Tick, Tick)] -> LineHits
makeLineHits Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
hits = [(Tick, (Tick, Tick))] -> LineHits
ticksToHits (forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> [(i, e)]
assocs Array Tick (Tick, Tick)
merged)
  where
    merged :: Array Tick (Tick, Tick)
merged = forall i e. (forall s. ST s (STArray s i e)) -> Array i e
runSTArray forall a b. (a -> b) -> a -> b
$ do
      STArray s Tick (Tick, Tick)
arr <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Tick
min_line, Tick
max_line) (Tick
ignored, Tick
0)
      forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall s.
STArray s Tick (Tick, Tick) -> (Tick, Tick, Tick) -> ST s ()
updateOne STArray s Tick (Tick, Tick)
arr) [(Tick, Tick, Tick)]
hits
      forall (m :: * -> *) a. Monad m => a -> m a
return STArray s Tick (Tick, Tick)
arr

    updateOne :: STArray s Int (Tick, Count) -> (Int, Tick, Count) -> ST s ()
    updateOne :: forall s.
STArray s Tick (Tick, Tick) -> (Tick, Tick, Tick) -> ST s ()
updateOne STArray s Tick (Tick, Tick)
arr (Tick
i, Tick
hit, Tick
count) = do
      (Tick
old_hit, Tick
old_count) <- forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STArray s Tick (Tick, Tick)
arr Tick
i
      forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STArray s Tick (Tick, Tick)
arr Tick
i (Tick -> Tick -> Tick
mergeEntry Tick
old_hit Tick
hit, forall a. Ord a => a -> a -> a
max Tick
old_count Tick
count)

    mergeEntry :: Tick -> Tick -> Tick
mergeEntry Tick
prev Tick
curr
      | Tick -> Bool
isMissed Tick
prev, Tick -> Bool
isFull Tick
curr = Tick
partial
      | Tick -> Bool
isFull Tick
prev, Tick -> Bool
isMissed Tick
curr = Tick
partial
      | Tick -> Bool
isPartial Tick
prev = Tick
prev
      | Bool
otherwise = Tick
curr

-- | Convert array of ticks to list of hits.
ticksToHits :: [(Int, (Tick, Count))] -> LineHits
ticksToHits :: [(Tick, (Tick, Tick))] -> LineHits
ticksToHits = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a}. (a, (Tick, Tick)) -> [(a, Hit)] -> [(a, Hit)]
f []
  where
    f :: (a, (Tick, Tick)) -> [(a, Hit)] -> [(a, Hit)]
f (a
i,(Tick
tck,Tick
n)) [(a, Hit)]
acc
      | Tick -> Bool
isIgnored Tick
tck = [(a, Hit)]
acc
      | Tick -> Bool
isMissed Tick
tck  = (a
i, Hit
Missed) forall a. a -> [a] -> [a]
: [(a, Hit)]
acc
      | Tick -> Bool
isFull Tick
tck    = (a
i, Tick -> Hit
Full Tick
n) forall a. a -> [a] -> [a]
: [(a, Hit)]
acc
      | Bool
otherwise     = (a
i, Tick -> Hit
Partial Tick
n) forall a. a -> [a] -> [a]
: [(a, Hit)]
acc

ignored, missed, partial, full :: Tick
ignored :: Tick
ignored = -Tick
1
missed :: Tick
missed = Tick
0
partial :: Tick
partial = Tick
1
full :: Tick
full = Tick
2

isIgnored :: Tick -> Bool
isIgnored :: Tick -> Bool
isIgnored = (forall a. Eq a => a -> a -> Bool
== Tick
ignored)

isMissed :: Tick -> Bool
isMissed :: Tick -> Bool
isMissed = (forall a. Eq a => a -> a -> Bool
== Tick
missed)

isPartial :: Tick -> Bool
isPartial :: Tick -> Bool
isPartial = (forall a. Eq a => a -> a -> Bool
== Tick
partial)

isFull :: Tick -> Bool
isFull :: Tick -> Bool
isFull = (forall a. Eq a => a -> a -> Bool
== Tick
full)

notTicked, ticked :: Tick
notTicked :: Tick
notTicked = Tick
missed
ticked :: Tick
ticked = Tick
full

-- See also: "utils/hpc/HpcMarkup.hs" in "ghc" git repository.
makeInfo :: Int -> [Integer] -> [MixEntry] -> Info
makeInfo :: Tick -> [Integer] -> [MixEntry] -> Info
makeInfo Tick
size [Integer]
tixs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Info -> MixEntry -> Info
f Info
z
  where
    z :: Info
z = Tick
-> Tick
-> Tick
-> [(Tick, Tick, Tick)]
-> FunctionHits
-> PreBranchHits
-> Info
Info Tick
0 forall a. Bounded a => a
maxBound Tick
0 [] [] []
    f :: Info -> MixEntry -> Info
f (Info Tick
i0 Tick
min_line Tick
max_line [(Tick, Tick, Tick)]
txs FunctionHits
fns PreBranchHits
brs) (HpcPos
pos, BoxLabel
boxLabel) =
      let binBox :: [(Tick, Tick, Tick)]
binBox =
            case (Tick -> Bool
isTicked Tick
i0, Tick -> Bool
isTicked Tick
i1) of
              (Bool
False, Bool
False) -> [(Tick, Tick, Tick)]
txs
              (Bool
True,  Bool
False) -> (Tick
sl, Tick
partial, Tick -> Tick
numTicked Tick
i0) forall a. a -> [a] -> [a]
: [(Tick, Tick, Tick)]
txs
              (Bool
False, Bool
True)  -> (Tick
sl, Tick
partial, Tick -> Tick
numTicked Tick
i1) forall a. a -> [a] -> [a]
: [(Tick, Tick, Tick)]
txs
              (Bool
True, Bool
True)   -> [(Tick, Tick, Tick)]
txs
          tickBox :: [(Tick, Tick, Tick)]
tickBox =
            let t :: Tick
t | Tick -> Bool
isTicked Tick
i0 = Tick
ticked
                  | Bool
otherwise = Tick
notTicked
            in  (Tick
sl, Tick
t, Tick -> Tick
numTicked Tick
i0) forall a. a -> [a] -> [a]
: [(Tick, Tick, Tick)]
txs
          tlBox :: [FilePath] -> FunctionHits
tlBox [FilePath]
ns = (Tick
sl, Tick
el, Tick -> Tick
numTicked Tick
i0, forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." [FilePath]
ns) forall a. a -> [a] -> [a]
: FunctionHits
fns
          br :: b -> (Tick, b, Tick)
br b
bool = (Tick
sl, b
bool, Tick -> Tick
numTicked Tick
i0)
          ([(Tick, Tick, Tick)]
txs', FunctionHits
fns', PreBranchHits
brs') =
            case BoxLabel
boxLabel of
              ExpBox {}      -> ([(Tick, Tick, Tick)]
tickBox, FunctionHits
fns, PreBranchHits
brs)
              TopLevelBox [FilePath]
ns -> ([(Tick, Tick, Tick)]
tickBox, [FilePath] -> FunctionHits
tlBox [FilePath]
ns, PreBranchHits
brs)
              LocalBox {}    -> ([(Tick, Tick, Tick)]
tickBox, FunctionHits
fns, PreBranchHits
brs)
              BinBox CondBox
_ Bool
True  -> ([(Tick, Tick, Tick)]
binBox, FunctionHits
fns, forall {b}. b -> (Tick, b, Tick)
br Bool
True forall a. a -> [a] -> [a]
: PreBranchHits
brs)
              BinBox CondBox
_ Bool
False -> ([(Tick, Tick, Tick)]
txs, FunctionHits
fns, forall {b}. b -> (Tick, b, Tick)
br Bool
False forall a. a -> [a] -> [a]
: PreBranchHits
brs)
          (Tick
sl, Tick
_, Tick
el, Tick
_) = HpcPos -> (Tick, Tick, Tick, Tick)
fromHpcPos HpcPos
pos
          i1 :: Tick
i1 = Tick
i0 forall a. Num a => a -> a -> a
+ Tick
1
      in Tick
-> Tick
-> Tick
-> [(Tick, Tick, Tick)]
-> FunctionHits
-> PreBranchHits
-> Info
Info Tick
i1 (forall a. Ord a => a -> a -> a
min Tick
sl Tick
min_line) (forall a. Ord a => a -> a -> a
max Tick
el Tick
max_line) [(Tick, Tick, Tick)]
txs' FunctionHits
fns' PreBranchHits
brs'

    -- Hope that the mix file does not contain out of bound index.
    numTicked :: Tick -> Tick
numTicked = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> Tick -> e
unsafeAt UArray Tick Tick
arr_tix
    isTicked :: Tick -> Bool
isTicked Tick
n = Tick -> Tick
numTicked Tick
n forall a. Eq a => a -> a -> Bool
/= Tick
0

    arr_tix :: UArray Int Tick
    arr_tix :: UArray Tick Tick
arr_tix = forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Tick
0, Tick
size forall a. Num a => a -> a -> a
- Tick
1) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
fromIntegral [Integer]
tixs)