GHC.HsToCore.Coverage doesn't take expressions in View Patterns into account
{-# LANGUAGE ViewPatterns #-}
main = do
x <- readLn
let str (if x == 0 then id else const 2 -> y) = show y
putStrLn (str 1)
{-
$ hpc report Main
100% expressions used (7/7)
100% boolean coverage (0/0)
100% guards (0/0)
100% 'if' conditions (0/0)
100% qualifiers (0/0)
100% alternatives used (0/0)
100% local declarations used (1/1)
100% top-level declarations used (1/1)
-}
{-
Changing str to
let str z = let y = (if x == 0 then id else const 2) z in show y
results in
$ hpc report Main
86% expressions used (13/15)
0% boolean coverage (0/1)
100% guards (0/0)
0% 'if' conditions (0/1), 1 always True
100% qualifiers (0/0)
50% alternatives used (1/2)
100% local declarations used (2/2)
100% top-level declarations used (1/1)
-}
Specifically, the problem is in addTickMatch
and addTickCmdMatch
. They are defined like so:
addTickMatch isOneOfMany isLambda match@(Match { m_pats = pats
, m_grhss = gRHSs }) =
bindLocals (collectPatsBinders pats) $ do
gRHSs' <- addTickGRHSs isOneOfMany isLambda gRHSs
return $ match { m_grhss = gRHSs' }
They return the pats
as they occurred in the original expression and don't add ticks in the expressions inside them.
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information