{-# LANGUAGE CPP #-}
-- |
-- Module:     Trace.Hpc.Codecov.Report
-- Copyright:  (c) 2020 8c6794b6
-- License:    BSD3
-- Maintainer: 8c6794b6 <8c6794b6@gmail.com>
--
-- Generate Codecov report data.

module Trace.Hpc.Codecov.Report
  ( -- * Types
    Report(..)
  , CoverageEntry(..)
  , LineHits
  , Hit(..)

    -- * Functions
  , genReport
  , genCoverageEntries
  , emitCoverageJSON
  ) where

-- base
import Control.Exception       (ErrorCall, handle, throwIO)
import Control.Monad           (when)
import Control.Monad.ST        (ST)
import Data.List               (foldl', intersperse)
import System.IO               (IOMode (..), hPutStrLn, stderr, stdout,
                                withFile)
#if !MIN_VERSION_base(4,11,0)
import Data.Monoid             ((<>))
#endif

-- array
import Data.Array.Base         (unsafeAt)
import Data.Array.IArray       (bounds, listArray, range, (!))
import Data.Array.MArray       (newArray, readArray, writeArray)
import Data.Array.ST           (STUArray, runSTUArray)
import Data.Array.Unboxed      (UArray)

-- bytestring
import Data.ByteString.Builder (Builder, char7, hPutBuilder, intDec,
                                string7, stringUtf8)

-- directory
import System.Directory        (doesFileExist)

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

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

-- Internal
import Trace.Hpc.Codecov.Error
-- import Trace.Hpc.Codecov.Options


-- ------------------------------------------------------------------------
--
-- Exported
--
-- ------------------------------------------------------------------------

-- | 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 JSON report, if given.
 , Report -> Bool
reportVerbose  :: Bool
   -- ^ Flag for showing verbose message during report generation.
 } deriving (Report -> Report -> Bool
(Report -> Report -> Bool)
-> (Report -> Report -> Bool) -> Eq Report
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, Int -> Report -> ShowS
[Report] -> ShowS
Report -> FilePath
(Int -> Report -> ShowS)
-> (Report -> FilePath) -> ([Report] -> ShowS) -> Show Report
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> FilePath
$cshow :: Report -> FilePath
showsPrec :: Int -> Report -> ShowS
$cshowsPrec :: Int -> Report -> ShowS
Show)

-- | Single file entry in coverage report.
--
-- See the
-- <https://docs.codecov.io/reference#section-codecov-json-report-format Codecov API>
-- for detail.
data CoverageEntry =
  CoverageEntry { CoverageEntry -> FilePath
ce_filename :: FilePath -- ^ Source code file name.
                , CoverageEntry -> LineHits
ce_hits     :: LineHits -- ^ Line hits of the file.
                } deriving (CoverageEntry -> CoverageEntry -> Bool
(CoverageEntry -> CoverageEntry -> Bool)
-> (CoverageEntry -> CoverageEntry -> Bool) -> Eq CoverageEntry
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, Int -> CoverageEntry -> ShowS
[CoverageEntry] -> ShowS
CoverageEntry -> FilePath
(Int -> CoverageEntry -> ShowS)
-> (CoverageEntry -> FilePath)
-> ([CoverageEntry] -> ShowS)
-> Show CoverageEntry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CoverageEntry] -> ShowS
$cshowList :: [CoverageEntry] -> ShowS
show :: CoverageEntry -> FilePath
$cshow :: CoverageEntry -> FilePath
showsPrec :: Int -> CoverageEntry -> ShowS
$cshowsPrec :: Int -> CoverageEntry -> ShowS
Show)

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

-- | Data type to represent coverage of source code line.
data Hit
  = Missed  -- ^ The line is not covered at all.
  | Partial -- ^ The line is partially covered.
  | Full    -- ^ The line is fully covered.
  deriving (Hit -> Hit -> Bool
(Hit -> Hit -> Bool) -> (Hit -> Hit -> Bool) -> Eq Hit
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, Int -> Hit -> ShowS
[Hit] -> ShowS
Hit -> FilePath
(Int -> Hit -> ShowS)
-> (Hit -> FilePath) -> ([Hit] -> ShowS) -> Show Hit
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Hit] -> ShowS
$cshowList :: [Hit] -> ShowS
show :: Hit -> FilePath
$cshow :: Hit -> FilePath
showsPrec :: Int -> Hit -> ShowS
$cshowsPrec :: Int -> Hit -> ShowS
Show)

-- | Generate report data from options.
genReport :: Report -> IO ()
genReport :: Report -> IO ()
genReport Report
rpt =
  do [CoverageEntry]
entries <- Report -> IO [CoverageEntry]
genCoverageEntries Report
rpt
     let mb_out :: Maybe FilePath
mb_out = Report -> Maybe FilePath
reportOutFile Report
rpt
         oname :: FilePath
oname = FilePath -> ShowS -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
"stdout" ShowS
forall a. Show a => a -> FilePath
show Maybe FilePath
mb_out
     Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Writing JSON report to " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
oname)
     Maybe FilePath -> [CoverageEntry] -> IO ()
emitCoverageJSON Maybe FilePath
mb_out [CoverageEntry]
entries
     Report -> FilePath -> IO ()
say Report
rpt FilePath
"Done"

-- | Generate test coverage entries.
genCoverageEntries :: Report -> IO [CoverageEntry]
genCoverageEntries :: Report -> IO [CoverageEntry]
genCoverageEntries Report
rpt =
  Report -> FilePath -> IO Tix
readTixFile Report
rpt (Report -> FilePath
reportTix Report
rpt) IO Tix -> (Tix -> IO [CoverageEntry]) -> IO [CoverageEntry]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Report -> Tix -> IO [CoverageEntry]
tixToCoverage Report
rpt

-- | Emit simple coverage JSON data.
emitCoverageJSON ::
  Maybe FilePath -- ^ 'Just' output file name, or 'Nothing' for
                 -- 'stdout'.
  -> [CoverageEntry] -- ^ Coverage entries to write.
  -> IO ()
emitCoverageJSON :: Maybe FilePath -> [CoverageEntry] -> IO ()
emitCoverageJSON Maybe FilePath
mb_outfile [CoverageEntry]
entries = (Handle -> IO ()) -> IO ()
forall r. (Handle -> IO r) -> IO r
wrap Handle -> IO ()
emit
  where
    wrap :: (Handle -> IO r) -> IO r
wrap = ((Handle -> IO r) -> IO r)
-> (FilePath -> (Handle -> IO r) -> IO r)
-> Maybe FilePath
-> (Handle -> IO r)
-> IO r
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Handle -> IO r) -> Handle -> IO r
forall a b. (a -> b) -> a -> b
$ Handle
stdout) (FilePath -> IOMode -> (Handle -> IO r) -> IO r
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
`withFile` IOMode
WriteMode) Maybe FilePath
mb_outfile
    emit :: Handle -> IO ()
emit = (Handle -> Builder -> IO ()) -> Builder -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> Builder -> IO ()
hPutBuilder ([CoverageEntry] -> Builder
buildJSON [CoverageEntry]
entries)


-- ------------------------------------------------------------------------
--
-- Internal
--
-- ------------------------------------------------------------------------

-- | Build simple JSON report from coverage entries.
buildJSON :: [CoverageEntry] -> Builder
buildJSON :: [CoverageEntry] -> Builder
buildJSON [CoverageEntry]
entries = Builder
contents
  where
    contents :: Builder
contents =
      Builder -> Builder
braced (Builder -> Builder
key (FilePath -> Builder
string7 FilePath
"coverage") Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
              Builder -> Builder
braced ([Builder] -> Builder
listify ((CoverageEntry -> Builder) -> [CoverageEntry] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map CoverageEntry -> Builder
report [CoverageEntry]
entries))) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Char -> Builder
char7 Char
'\n'
    report :: CoverageEntry -> Builder
report CoverageEntry
ce =
      Builder -> Builder
key (FilePath -> Builder
stringUtf8 (CoverageEntry -> FilePath
ce_filename CoverageEntry
ce)) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
      Builder -> Builder
braced ([Builder] -> Builder
listify (((Int, Hit) -> Builder) -> LineHits -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Hit) -> Builder
hit (CoverageEntry -> LineHits
ce_hits CoverageEntry
ce)))
    key :: Builder -> Builder
key Builder
x = Builder -> Builder
dquote Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':'
    dquote :: Builder -> Builder
dquote Builder
x = Char -> Builder
char7 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'
    braced :: Builder -> Builder
braced Builder
x = Char -> Builder
char7 Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'}'
    listify :: [Builder] -> Builder
listify [Builder]
xs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse Builder
comma [Builder]
xs)
    comma :: Builder
comma = Char -> Builder
char7 Char
','
    hit :: (Int, Hit) -> Builder
hit (Int
n, Hit
tag) =
      case Hit
tag of
        Hit
Missed  -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'0'
        Hit
Partial -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> Builder
dquote (Char -> Builder
char7 Char
'1' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'/' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'2')
        Hit
Full    -> Builder
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'1'
      where
        k :: Builder
k = Builder -> Builder
key (Int -> Builder
intDec Int
n)

tixToCoverage :: Report -> Tix -> IO [CoverageEntry]
tixToCoverage :: Report -> Tix -> IO [CoverageEntry]
tixToCoverage Report
rpt (Tix [TixModule]
tms) = (TixModule -> IO CoverageEntry)
-> [TixModule] -> IO [CoverageEntry]
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 Int
_count [Integer]
_ixs) =
  do Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Search mix:   " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
name)
     Mix FilePath
path UTCTime
_ Hash
_ Int
_ [MixEntry]
entries <- [FilePath] -> TixModule -> IO Mix
readMixFile (Report -> [FilePath]
reportMixDirs Report
rpt) TixModule
tm
     Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found mix:    "FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path)
     let Info Int
_ Int
min_line Int
max_line [(HpcPos, Int)]
hits = TixModule -> [MixEntry] -> Info
makeInfo TixModule
tm [MixEntry]
entries
         lineHits :: LineHits
lineHits = Int -> Int -> [(HpcPos, Int)] -> LineHits
makeLineHits Int
min_line Int
max_line [(HpcPos, Int)]
hits
     FilePath
path' <- Report -> FilePath -> IO FilePath
ensureSrcPath Report
rpt FilePath
path
     CoverageEntry -> IO CoverageEntry
forall (m :: * -> *) a. Monad m => a -> m a
return (CoverageEntry :: FilePath -> LineHits -> CoverageEntry
CoverageEntry { ce_filename :: FilePath
ce_filename = FilePath
path'
                           , ce_hits :: LineHits
ce_hits = LineHits
lineHits })

-- | Exclude modules specified in given 'Report'.
excludeModules :: Report -> [TixModule] -> [TixModule]
excludeModules :: Report -> [TixModule] -> [TixModule]
excludeModules Report
rpt = (TixModule -> Bool) -> [TixModule] -> [TixModule]
forall a. (a -> Bool) -> [a] -> [a]
filter TixModule -> Bool
exclude
  where
    exclude :: TixModule -> Bool
exclude (TixModule FilePath
pkg_slash_name Hash
_ Int
_ [Integer]
_) =
      let modname :: FilePath
modname = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
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  FilePath -> [FilePath] -> Bool
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 <- FilePath -> IO (Maybe Tix)
readTix FilePath
path
     case Maybe Tix
mb_tix of
       Maybe Tix
Nothing  -> HpcCodecovError -> IO Tix
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: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path) IO () -> IO Tix -> IO Tix
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Tix -> IO Tix
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 Int
_c [Integer]
_i) =
  (ErrorCall -> IO Mix) -> IO Mix -> IO Mix
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ErrorCall -> IO Mix
forall a. ErrorCall -> IO a
handler ([FilePath] -> Either FilePath TixModule -> IO Mix
readMix [FilePath]
dirs (TixModule -> Either FilePath TixModule
forall a b. b -> Either a b
Right TixModule
tm))
  where
    handler :: ErrorCall -> IO a
    handler :: ErrorCall -> IO a
handler ErrorCall
_ = HpcCodecovError -> IO a
forall e a. Exception e => e -> IO a
throwIO (FilePath -> [FilePath] -> HpcCodecovError
MixNotFound FilePath
name [FilePath]
dirs')
    dirs' :: [FilePath]
dirs' = ShowS -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> ShowS
</> (FilePath
name FilePath -> ShowS
<.> FilePath
"mix")) [FilePath]
dirs

-- | 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 [] = HpcCodecovError -> IO FilePath
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 do Report -> FilePath -> IO ()
say Report
rpt (FilePath
"Found source: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
path')
                    FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
path'
            else [FilePath] -> [FilePath] -> IO FilePath
go (FilePath
path'FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
acc) [FilePath]
dirs

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

-- | Internal type synonym to represent code line hit.
type Tick = Int

-- | Internal type used for accumulating mix entries.
data Info =
  Info {-# UNPACK #-} !Int -- ^ Index count
       {-# UNPACK #-} !Int -- ^ Min line number
       {-# UNPACK #-} !Int -- ^ Max line number
       ![(HpcPos, Tick)] -- ^ Pair of position and hit

-- | Make line hits from intermediate info.
makeLineHits :: Int -> Int -> [(HpcPos, Tick)] -> LineHits
makeLineHits :: Int -> Int -> [(HpcPos, Int)] -> LineHits
makeLineHits Int
min_line Int
max_line [(HpcPos, Int)]
hits = UArray Int Int -> LineHits
ticksToHits ((forall s. ST s (STUArray s Int Int)) -> UArray Int Int
forall i e. (forall s. ST s (STUArray s i e)) -> UArray i e
runSTUArray forall s. ST s (STUArray s Int Int)
work)
  where
    work :: ST s (STUArray s Int Int)
work =
      do STUArray s Int Int
arr <- (Int, Int) -> Int -> ST s (STUArray s Int Int)
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
(i, i) -> e -> m (a i e)
newArray (Int
min_line, Int
max_line) Int
ignored
         ((HpcPos, Int) -> ST s ()) -> [(HpcPos, Int)] -> ST s ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (STUArray s Int Int -> (HpcPos, Int) -> ST s ()
forall s. STUArray s Int Int -> (HpcPos, Int) -> ST s ()
updateHit STUArray s Int Int
arr) [(HpcPos, Int)]
hits
         STUArray s Int Int -> ST s (STUArray s Int Int)
forall (m :: * -> *) a. Monad m => a -> m a
return STUArray s Int Int
arr
    updateHit :: STUArray s Int Int -> (HpcPos, Int) -> ST s ()
updateHit STUArray s Int Int
arr (HpcPos
pos, Int
hit) =
      let (Int
ls, Int
_, Int
_, Int
_) = HpcPos -> (Int, Int, Int, Int)
fromHpcPos HpcPos
pos
      in  STUArray s Int Int -> Int -> Int -> ST s ()
forall s. STUArray s Int Int -> Int -> Int -> ST s ()
updateOne STUArray s Int Int
arr Int
hit Int
ls
    updateOne :: STUArray s Int Int -> Tick -> Int -> ST s ()
    updateOne :: STUArray s Int Int -> Int -> Int -> ST s ()
updateOne STUArray s Int Int
arr Int
hit Int
i =
      do Int
prev <- STUArray s Int Int -> Int -> ST s Int
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> m e
readArray STUArray s Int Int
arr Int
i
         STUArray s Int Int -> Int -> Int -> ST s ()
forall (a :: * -> * -> *) e (m :: * -> *) i.
(MArray a e m, Ix i) =>
a i e -> i -> e -> m ()
writeArray STUArray s Int Int
arr Int
i (Int -> Int -> Int
mergeEntry Int
prev Int
hit)
    mergeEntry :: Int -> Int -> Int
mergeEntry Int
prev Int
hit
      | Int -> Bool
isIgnored Int
prev              = Int
hit
      | Int -> Bool
isMissed Int
prev, Int -> Bool
isMissed Int
hit = Int
missed
      | Int -> Bool
isFull Int
prev, Int -> Bool
isFull Int
hit     = Int
full
      | Bool
otherwise                   = Int
partial

-- | Convert array of ticks to list of hits.
ticksToHits :: UArray Int Tick -> LineHits
ticksToHits :: UArray Int Int -> LineHits
ticksToHits UArray Int Int
arr = (Int -> LineHits -> LineHits) -> LineHits -> [Int] -> LineHits
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Int -> LineHits -> LineHits
f [] ((Int, Int) -> [Int]
forall a. Ix a => (a, a) -> [a]
range (UArray Int Int -> (Int, Int)
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> (i, i)
bounds UArray Int Int
arr))
  where
    f :: Int -> LineHits -> LineHits
f Int
i LineHits
acc =
      case UArray Int Int
arr UArray Int Int -> Int -> Int
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
! Int
i of
        Int
tck | Int -> Bool
isIgnored Int
tck -> LineHits
acc
            | Int -> Bool
isMissed Int
tck  -> (Int
i, Hit
Missed) (Int, Hit) -> LineHits -> LineHits
forall a. a -> [a] -> [a]
: LineHits
acc
            | Int -> Bool
isFull Int
tck    -> (Int
i, Hit
Full) (Int, Hit) -> LineHits -> LineHits
forall a. a -> [a] -> [a]
: LineHits
acc
            | Bool
otherwise     -> (Int
i, Hit
Partial) (Int, Hit) -> LineHits -> LineHits
forall a. a -> [a] -> [a]
: LineHits
acc

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

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

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

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

notTicked, tickedOnlyTrue, tickedOnlyFalse, ticked :: Tick
notTicked :: Int
notTicked = Int
missed
tickedOnlyTrue :: Int
tickedOnlyTrue = Int
partial
tickedOnlyFalse :: Int
tickedOnlyFalse = Int
partial
ticked :: Int
ticked = Int
full

-- See also: "utils/hpc/HpcMarkup.hs" in "ghc" git repository.
makeInfo :: TixModule -> [MixEntry] -> Info
makeInfo :: TixModule -> [MixEntry] -> Info
makeInfo TixModule
tm = (Info -> MixEntry -> Info) -> Info -> [MixEntry] -> Info
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Info -> MixEntry -> Info
f Info
z
  where
    z :: Info
z = Int -> Int -> Int -> [(HpcPos, Int)] -> Info
Info Int
0 Int
forall a. Bounded a => a
maxBound Int
0 []
    f :: Info -> MixEntry -> Info
f (Info Int
i Int
min_line Int
max_line [(HpcPos, Int)]
acc) (HpcPos
pos, BoxLabel
boxLabel) =
      let binBox :: [(HpcPos, Int)]
binBox = case (Int -> Bool
isTicked Int
i, Int -> Bool
isTicked (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)) of
                     (Bool
False, Bool
False) -> [(HpcPos, Int)]
acc
                     (Bool
True,  Bool
False) -> (HpcPos
pos, Int
tickedOnlyTrue) (HpcPos, Int) -> [(HpcPos, Int)] -> [(HpcPos, Int)]
forall a. a -> [a] -> [a]
: [(HpcPos, Int)]
acc
                     (Bool
False, Bool
True)  -> (HpcPos
pos, Int
tickedOnlyFalse) (HpcPos, Int) -> [(HpcPos, Int)] -> [(HpcPos, Int)]
forall a. a -> [a] -> [a]
: [(HpcPos, Int)]
acc
                     (Bool
True, Bool
True)   -> [(HpcPos, Int)]
acc
          tickBox :: [(HpcPos, Int)]
tickBox = if Int -> Bool
isTicked Int
i
                       then (HpcPos
pos, Int
ticked) (HpcPos, Int) -> [(HpcPos, Int)] -> [(HpcPos, Int)]
forall a. a -> [a] -> [a]
: [(HpcPos, Int)]
acc
                       else (HpcPos
pos, Int
notTicked) (HpcPos, Int) -> [(HpcPos, Int)] -> [(HpcPos, Int)]
forall a. a -> [a] -> [a]
: [(HpcPos, Int)]
acc
          acc' :: [(HpcPos, Int)]
acc' = case BoxLabel
boxLabel of
                   ExpBox {}      -> [(HpcPos, Int)]
tickBox
                   TopLevelBox {} -> [(HpcPos, Int)]
tickBox
                   LocalBox {}    -> [(HpcPos, Int)]
tickBox
                   BinBox _ True  -> [(HpcPos, Int)]
binBox
                   BoxLabel
_              -> [(HpcPos, Int)]
acc
          (Int
ls, Int
_, Int
le, Int
_) = HpcPos -> (Int, Int, Int, Int)
fromHpcPos HpcPos
pos
      in Int -> Int -> Int -> [(HpcPos, Int)] -> Info
Info (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
ls Int
min_line) (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
le Int
max_line) [(HpcPos, Int)]
acc'

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

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