diff --git a/HpcCombine.hs b/HpcCombine.hs
index 190a727a5f382067bc9bfe3d0c0f51cbf4191839..b57112f45e3c1593726f3661b9f3181694df0cbb 100644
--- a/HpcCombine.hs
+++ b/HpcCombine.hs
@@ -3,7 +3,7 @@
-- Andy Gill, Oct 2006
---------------------------------------------------------
-module HpcCombine (sum_plugin,combine_plugin,map_plugin) where
+module HpcCombine (sum_plugin,combine_plugin,map_plugin) where
import Trace.Hpc.Tix
import Trace.Hpc.Util
@@ -16,70 +16,70 @@ import qualified Data.Map as Map
------------------------------------------------------------------------------
sum_options :: FlagOptSeq
-sum_options
+sum_options
= excludeOpt
. includeOpt
. outputOpt
- . unionModuleOpt
+ . unionModuleOpt
sum_plugin :: Plugin
sum_plugin = Plugin { name = "sum"
- , usage = "[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]"
- , options = sum_options
- , summary = "Sum multiple .tix files in a single .tix file"
- , implementation = sum_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]"
+ , options = sum_options
+ , summary = "Sum multiple .tix files in a single .tix file"
+ , implementation = sum_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
combine_options :: FlagOptSeq
-combine_options
+combine_options
= excludeOpt
. includeOpt
. outputOpt
. combineFunOpt
. combineFunOptInfo
- . unionModuleOpt
+ . unionModuleOpt
combine_plugin :: Plugin
combine_plugin = Plugin { name = "combine"
- , usage = "[OPTION] .. <TIX_FILE> <TIX_FILE>"
- , options = combine_options
- , summary = "Combine two .tix files in a single .tix file"
- , implementation = combine_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[OPTION] .. <TIX_FILE> <TIX_FILE>"
+ , options = combine_options
+ , summary = "Combine two .tix files in a single .tix file"
+ , implementation = combine_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
map_options :: FlagOptSeq
-map_options
+map_options
= excludeOpt
. includeOpt
. outputOpt
- . mapFunOpt
+ . mapFunOpt
. mapFunOptInfo
- . unionModuleOpt
+ . unionModuleOpt
map_plugin :: Plugin
map_plugin = Plugin { name = "map"
- , usage = "[OPTION] .. <TIX_FILE> "
- , options = map_options
- , summary = "Map a function over a single .tix file"
- , implementation = map_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[OPTION] .. <TIX_FILE> "
+ , options = map_options
+ , summary = "Map a function over a single .tix file"
+ , implementation = map_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
------------------------------------------------------------------------------
sum_main :: Flags -> [String] -> IO ()
-sum_main _ [] = hpcError sum_plugin $ "no .tix file specified"
+sum_main _ [] = hpcError sum_plugin $ "no .tix file specified"
sum_main flags (first_file:more_files) = do
Just tix <- readTix first_file
- tix' <- foldM (mergeTixFile flags (+))
- (filterTix flags tix)
- more_files
+ tix' <- foldM (mergeTixFile flags (+))
+ (filterTix flags tix)
+ more_files
case outputFile flags of
"-" -> putStrLn (show tix')
@@ -92,10 +92,10 @@ combine_main flags [first_file,second_file] = do
Just tix1 <- readTix first_file
Just tix2 <- readTix second_file
- let tix = mergeTix (mergeModule flags)
- f
- (filterTix flags tix1)
- (filterTix flags tix2)
+ let tix = mergeTix (mergeModule flags)
+ f
+ (filterTix flags tix1)
+ (filterTix flags tix2)
case outputFile flags of
"-" -> putStrLn (show tix)
@@ -110,55 +110,55 @@ map_main flags [first_file] = do
let (Tix inside_tix) = filterTix flags tix
let tix' = Tix [ TixModule m p i (map f t)
- | TixModule m p i t <- inside_tix
- ]
+ | TixModule m p i t <- inside_tix
+ ]
case outputFile flags of
"-" -> putStrLn (show tix')
out -> writeTix out tix'
-map_main _ [] = hpcError map_plugin $ "no .tix file specified"
-map_main _ _ = hpcError map_plugin $ "to many .tix files specified"
+map_main _ [] = hpcError map_plugin $ "no .tix file specified"
+map_main _ _ = hpcError map_plugin $ "to many .tix files specified"
mergeTixFile :: Flags -> (Integer -> Integer -> Integer) -> Tix -> String -> IO Tix
mergeTixFile flags fn tix file_name = do
Just new_tix <- readTix file_name
return $! strict $ mergeTix (mergeModule flags) fn tix (filterTix flags new_tix)
--- could allow different numbering on the module info,
+-- could allow different numbering on the module info,
-- as long as the total is the same; will require normalization.
mergeTix :: MergeFun
- -> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix
+ -> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix
mergeTix modComb f
- (Tix t1)
- (Tix t2) = Tix
- [ case (Map.lookup m fm1,Map.lookup m fm2) of
- -- todo, revisit the semantics of this combination
- (Just (TixModule _ hash1 len1 tix1),Just (TixModule _ hash2 len2 tix2))
- | hash1 /= hash2
- || length tix1 /= length tix2
- || len1 /= length tix1
- || len2 /= length tix2
- -> error $ "mismatched in module " ++ m
- | otherwise ->
- TixModule m hash1 len1 (zipWith f tix1 tix2)
- (Just m1,Nothing) ->
- m1
- (Nothing,Just m2) ->
- m2
- _ -> error "impossible"
- | m <- Set.toList (theMergeFun modComb m1s m2s)
+ (Tix t1)
+ (Tix t2) = Tix
+ [ case (Map.lookup m fm1,Map.lookup m fm2) of
+ -- todo, revisit the semantics of this combination
+ (Just (TixModule _ hash1 len1 tix1),Just (TixModule _ hash2 len2 tix2))
+ | hash1 /= hash2
+ || length tix1 /= length tix2
+ || len1 /= length tix1
+ || len2 /= length tix2
+ -> error $ "mismatched in module " ++ m
+ | otherwise ->
+ TixModule m hash1 len1 (zipWith f tix1 tix2)
+ (Just m1,Nothing) ->
+ m1
+ (Nothing,Just m2) ->
+ m2
+ _ -> error "impossible"
+ | m <- Set.toList (theMergeFun modComb m1s m2s)
]
- where
- m1s = Set.fromList $ map tixModuleName t1
+ where
+ m1s = Set.fromList $ map tixModuleName t1
m2s = Set.fromList $ map tixModuleName t2
- fm1 = Map.fromList [ (tixModuleName tix,tix)
- | tix <- t1
- ]
- fm2 = Map.fromList [ (tixModuleName tix,tix)
- | tix <- t2
- ]
+ fm1 = Map.fromList [ (tixModuleName tix,tix)
+ | tix <- t1
+ ]
+ fm2 = Map.fromList [ (tixModuleName tix,tix)
+ | tix <- t2
+ ]
-- What I would give for a hyperstrict :-)
@@ -172,7 +172,7 @@ instance Strict Integer where
instance Strict Int where
strict i = i
-instance Strict Hash where -- should be fine, because Hash is a newtype round an Int
+instance Strict Hash where -- should be fine, because Hash is a newtype round an Int
strict i = i
instance Strict Char where
@@ -186,10 +186,10 @@ instance (Strict a, Strict b) => Strict (a,b) where
strict (a,b) = (((,) $! strict a) $! strict b)
instance Strict Tix where
- strict (Tix t1) =
- Tix $! strict t1
+ strict (Tix t1) =
+ Tix $! strict t1
instance Strict TixModule where
- strict (TixModule m1 p1 i1 t1) =
- ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1)
+ strict (TixModule m1 p1 i1 t1) =
+ ((((TixModule $! strict m1) $! strict p1) $! strict i1) $! strict t1)
diff --git a/HpcDraft.hs b/HpcDraft.hs
index 7b43352228737744c387dc8e7d9ba781ea3bf3ed..c0b5c47e15d9e64601910ff29d772010f7cb6f90 100644
--- a/HpcDraft.hs
+++ b/HpcDraft.hs
@@ -13,41 +13,41 @@ import Data.Tree
------------------------------------------------------------------------------
draft_options :: FlagOptSeq
-draft_options
+draft_options
= excludeOpt
. includeOpt
. srcDirOpt
. hpcDirOpt
. outputOpt
-
+
draft_plugin :: Plugin
draft_plugin = Plugin { name = "draft"
- , usage = "[OPTION] .. <TIX_FILE>"
- , options = draft_options
- , summary = "Generate draft overlay that provides 100% coverage"
- , implementation = draft_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[OPTION] .. <TIX_FILE>"
+ , options = draft_options
+ , summary = "Generate draft overlay that provides 100% coverage"
+ , implementation = draft_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
------------------------------------------------------------------------------
draft_main :: Flags -> [String] -> IO ()
draft_main _ [] = error "draft_main: unhandled case: []"
draft_main hpcflags (progName:mods) = do
- let hpcflags1 = hpcflags
- { includeMods = Set.fromList mods
- `Set.union`
- includeMods hpcflags }
- let prog = getTixFileName $ progName
- tix <- readTix prog
+ let hpcflags1 = hpcflags
+ { includeMods = Set.fromList mods
+ `Set.union`
+ includeMods hpcflags }
+ let prog = getTixFileName $ progName
+ tix <- readTix prog
case tix of
Just (Tix tickCounts) -> do
- outs <- sequence
- [ makeDraft hpcflags1 tixModule
- | tixModule@(TixModule m _ _ _) <- tickCounts
- , allowModule hpcflags1 m
- ]
+ outs <- sequence
+ [ makeDraft hpcflags1 tixModule
+ | tixModule@(TixModule m _ _ _) <- tickCounts
+ , allowModule hpcflags1 m
+ ]
case outputFile hpcflags1 of
"-" -> putStrLn (unlines outs)
out -> writeFile out (unlines outs)
@@ -55,13 +55,13 @@ draft_main hpcflags (progName:mods) = do
makeDraft :: Flags -> TixModule -> IO String
-makeDraft hpcflags tix = do
+makeDraft hpcflags tix = do
let modu = tixModuleName tix
tixs = tixModuleTixs tix
(Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix)
- let forest = createMixEntryDom
+ let forest = createMixEntryDom
[ (srcspan,(box,v > 0))
| ((srcspan,box),v) <- zip entries tixs
]
@@ -77,7 +77,7 @@ makeDraft hpcflags tix = do
hsMap = Map.fromList (zip [1..] $ lines hs)
let quoteString = show
-
+
let firstLine pos = case fromHpcPos pos of
(ln,_,_,_) -> ln
@@ -88,10 +88,10 @@ makeDraft hpcflags tix = do
++ "on line " ++ show (firstLine pos) ++ ";"
showPleaseTick d (TickExp pos) =
spaces d ++ "tick "
- ++ if '\n' `elem` txt
+ ++ if '\n' `elem` txt
then "at position " ++ show pos ++ ";"
else quoteString txt ++ " " ++ "on line " ++ show (firstLine pos) ++ ";"
-
+
where
txt = grabHpcPos hsMap pos
@@ -133,8 +133,8 @@ findNotTickedFromTree (Node (pos,(TopLevelBox nm,False):_) _)
findNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _)
= [ TickFun nm pos ]
findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children)
- = mkTickInside nm pos (findNotTickedFromList children) []
-findNotTickedFromTree (Node (pos,_:others) children) =
+ = mkTickInside nm pos (findNotTickedFromList children) []
+findNotTickedFromTree (Node (pos,_:others) children) =
findNotTickedFromTree (Node (pos,others) children)
findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children
diff --git a/HpcFlags.hs b/HpcFlags.hs
index f5d699a04c8e03de9db92540aae08f7a90da540e..b66d418e6c696bd52a86822b3b974b9cfd51407f 100644
--- a/HpcFlags.hs
+++ b/HpcFlags.hs
@@ -9,29 +9,29 @@ import Trace.Hpc.Tix
import Trace.Hpc.Mix
import System.Exit
-data Flags = Flags
- { outputFile :: String
+data Flags = Flags
+ { outputFile :: String
, includeMods :: Set.Set String
, excludeMods :: Set.Set String
- , hpcDir :: String
- , srcDirs :: [String]
- , destDir :: String
+ , hpcDir :: String
+ , srcDirs :: [String]
+ , destDir :: String
- , perModule :: Bool
- , decList :: Bool
- , xmlOutput :: Bool
+ , perModule :: Bool
+ , decList :: Bool
+ , xmlOutput :: Bool
, funTotals :: Bool
, altHighlight :: Bool
- , combineFun :: CombineFun -- tick-wise combine
- , postFun :: PostFun --
- , mergeModule :: MergeFun -- module-wise merge
+ , combineFun :: CombineFun -- tick-wise combine
+ , postFun :: PostFun --
+ , mergeModule :: MergeFun -- module-wise merge
}
default_flags :: Flags
default_flags = Flags
- { outputFile = "-"
+ { outputFile = "-"
, includeMods = Set.empty
, excludeMods = Set.empty
, hpcDir = ".hpc"
@@ -39,15 +39,15 @@ default_flags = Flags
, destDir = "."
, perModule = False
- , decList = False
- , xmlOutput = False
+ , decList = False
+ , xmlOutput = False
, funTotals = False
, altHighlight = False
, combineFun = ADD
, postFun = ID
- , mergeModule = INTERSECTION
+ , mergeModule = INTERSECTION
}
@@ -55,10 +55,10 @@ default_flags = Flags
-- depends on if specific flags we used.
default_final_flags :: Flags -> Flags
-default_final_flags flags = flags
+default_final_flags flags = flags
{ srcDirs = if null (srcDirs flags)
- then ["."]
- else srcDirs flags
+ then ["."]
+ else srcDirs flags
}
type FlagOptSeq = [OptDescr (Flags -> Flags)] -> [OptDescr (Flags -> Flags)]
@@ -76,10 +76,10 @@ excludeOpt, includeOpt, hpcDirOpt, srcDirOpt, destDirOpt, outputOpt,
perModuleOpt, decListOpt, xmlOutputOpt, funTotalsOpt,
altHighlightOpt, combineFunOpt, combineFunOptInfo, mapFunOpt,
mapFunOptInfo, unionModuleOpt :: FlagOptSeq
-excludeOpt = anArg "exclude" "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"
+excludeOpt = anArg "exclude" "exclude MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"
$ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
-includeOpt = anArg "include" "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"
+includeOpt = anArg "include" "include MODULE and/or PACKAGE" "[PACKAGE:][MODULE]"
$ \ a f -> f { includeMods = a `Set.insert` includeMods f }
hpcDirOpt = anArg "hpcdir" "sub-directory that contains .mix files" "DIR"
@@ -87,92 +87,92 @@ hpcDirOpt = anArg "hpcdir" "sub-directory that contains .mix files" "
. infoArg "default .hpc [rarely used]"
srcDirOpt = anArg "srcdir" "path to source directory of .hs files" "DIR"
- (\ a f -> f { srcDirs = srcDirs f ++ [a] })
- . infoArg "multi-use of srcdir possible"
-
+ (\ a f -> f { srcDirs = srcDirs f ++ [a] })
+ . infoArg "multi-use of srcdir possible"
+
destDirOpt = anArg "destdir" "path to write output to" "DIR"
- $ \ a f -> f { destDir = a }
+ $ \ a f -> f { destDir = a }
+
-
outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a }
-- markup
perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True }
-decListOpt = noArg "decl-list" "show unused decls" $ \ f -> f { decList = True }
-xmlOutputOpt = noArg "xml-output" "show output in XML" $ \ f -> f { xmlOutput = True }
-funTotalsOpt = noArg "fun-entry-count" "show top-level function entry counts"
- $ \ f -> f { funTotals = True }
-altHighlightOpt
- = noArg "highlight-covered" "highlight covered code, rather that code gaps"
- $ \ f -> f { altHighlight = True }
-
-combineFunOpt = anArg "function"
- "combine .tix files with join function, default = ADD" "FUNCTION"
- $ \ a f -> case reads (map toUpper a) of
- [(c,"")] -> f { combineFun = c }
- _ -> error $ "no such combine function : " ++ a
-combineFunOptInfo = infoArg
- $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst foldFuns)
+decListOpt = noArg "decl-list" "show unused decls" $ \ f -> f { decList = True }
+xmlOutputOpt = noArg "xml-output" "show output in XML" $ \ f -> f { xmlOutput = True }
+funTotalsOpt = noArg "fun-entry-count" "show top-level function entry counts"
+ $ \ f -> f { funTotals = True }
+altHighlightOpt
+ = noArg "highlight-covered" "highlight covered code, rather that code gaps"
+ $ \ f -> f { altHighlight = True }
+
+combineFunOpt = anArg "function"
+ "combine .tix files with join function, default = ADD" "FUNCTION"
+ $ \ a f -> case reads (map toUpper a) of
+ [(c,"")] -> f { combineFun = c }
+ _ -> error $ "no such combine function : " ++ a
+combineFunOptInfo = infoArg
+ $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst foldFuns)
mapFunOpt = anArg "function"
- "apply function to .tix files, default = ID" "FUNCTION"
- $ \ a f -> case reads (map toUpper a) of
- [(c,"")] -> f { postFun = c }
- _ -> error $ "no such combine function : " ++ a
-mapFunOptInfo = infoArg
- $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst postFuns)
+ "apply function to .tix files, default = ID" "FUNCTION"
+ $ \ a f -> case reads (map toUpper a) of
+ [(c,"")] -> f { postFun = c }
+ _ -> error $ "no such combine function : " ++ a
+mapFunOptInfo = infoArg
+ $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst postFuns)
unionModuleOpt = noArg "union"
- "use the union of the module namespace (default is intersection)"
- $ \ f -> f { mergeModule = UNION }
+ "use the union of the module namespace (default is intersection)"
+ $ \ f -> f { mergeModule = UNION }
-------------------------------------------------------------------------------
readMixWithFlags :: Flags -> Either String TixModule -> IO Mix
readMixWithFlags flags modu = readMix [ dir ++ "/" ++ hpcDir flags
- | dir <- srcDirs flags
+ | dir <- srcDirs flags
] modu
-------------------------------------------------------------------------------
command_usage :: Plugin -> IO ()
-command_usage plugin =
+command_usage plugin =
putStrLn $
- "Usage: hpc " ++ (name plugin) ++ " " ++
- (usage plugin) ++
- "\n" ++ summary plugin ++ "\n" ++
- if null (options plugin [])
- then ""
- else usageInfo "\n\nOptions:\n" (options plugin [])
+ "Usage: hpc " ++ (name plugin) ++ " " ++
+ (usage plugin) ++
+ "\n" ++ summary plugin ++ "\n" ++
+ if null (options plugin [])
+ then ""
+ else usageInfo "\n\nOptions:\n" (options plugin [])
hpcError :: Plugin -> String -> IO a
hpcError plugin msg = do
putStrLn $ "Error: " ++ msg
command_usage plugin
exitFailure
-
+
-------------------------------------------------------------------------------
data Plugin = Plugin { name :: String
- , usage :: String
- , options :: FlagOptSeq
- , summary :: String
- , implementation :: Flags -> [String] -> IO ()
- , init_flags :: Flags
- , final_flags :: Flags -> Flags
- }
+ , usage :: String
+ , options :: FlagOptSeq
+ , summary :: String
+ , implementation :: Flags -> [String] -> IO ()
+ , init_flags :: Flags
+ , final_flags :: Flags -> Flags
+ }
------------------------------------------------------------------------------
--- filterModules takes a list of candidate modules,
--- and
+-- filterModules takes a list of candidate modules,
+-- and
-- * excludes the excluded modules
-- * includes the rest if there are no explicity included modules
-- * otherwise, accepts just the included modules.
allowModule :: Flags -> String -> Bool
-allowModule flags full_mod
+allowModule flags full_mod
| full_mod' `Set.member` excludeMods flags = False
| pkg_name `Set.member` excludeMods flags = False
| mod_name `Set.member` excludeMods flags = False
@@ -180,38 +180,38 @@ allowModule flags full_mod
| full_mod' `Set.member` includeMods flags = True
| pkg_name `Set.member` includeMods flags = True
| mod_name `Set.member` includeMods flags = True
- | otherwise = False
+ | otherwise = False
where
full_mod' = pkg_name ++ mod_name
- -- pkg name always ends with '/', main
- (pkg_name,mod_name) =
- case span (/= '/') full_mod of
- (p,'/':m) -> (p ++ ":",m)
- (m,[]) -> (":",m)
- _ -> error "impossible case in allowModule"
+ -- pkg name always ends with '/', main
+ (pkg_name,mod_name) =
+ case span (/= '/') full_mod of
+ (p,'/':m) -> (p ++ ":",m)
+ (m,[]) -> (":",m)
+ _ -> error "impossible case in allowModule"
filterTix :: Flags -> Tix -> Tix
filterTix flags (Tix tixs) =
Tix $ filter (allowModule flags . tixModuleName) tixs
-
+
------------------------------------------------------------------------------
--- HpcCombine specifics
+-- HpcCombine specifics
-data CombineFun = ADD | DIFF | SUB
+data CombineFun = ADD | DIFF | SUB
deriving (Eq,Show, Read, Enum)
theCombineFun :: CombineFun -> Integer -> Integer -> Integer
theCombineFun fn = case fn of
- ADD -> \ l r -> l + r
+ ADD -> \ l r -> l + r
SUB -> \ l r -> max 0 (l - r)
- DIFF -> \ g b -> if g > 0 then 0 else min 1 b
+ DIFF -> \ g b -> if g > 0 then 0 else min 1 b
foldFuns :: [ (String,CombineFun) ]
-foldFuns = [ (show comb,comb)
- | comb <- [ADD .. SUB]
- ]
+foldFuns = [ (show comb,comb)
+ | comb <- [ADD .. SUB]
+ ]
data PostFun = ID | INV | ZERO
deriving (Eq,Show, Read, Enum)
@@ -223,9 +223,9 @@ thePostFun INV _ = 0
thePostFun ZERO _ = 0
postFuns :: [(String, PostFun)]
-postFuns = [ (show pos,pos)
- | pos <- [ID .. ZERO]
- ]
+postFuns = [ (show pos,pos)
+ | pos <- [ID .. ZERO]
+ ]
data MergeFun = INTERSECTION | UNION
@@ -236,7 +236,7 @@ theMergeFun INTERSECTION = Set.intersection
theMergeFun UNION = Set.union
mergeFuns :: [(String, MergeFun)]
-mergeFuns = [ (show pos,pos)
- | pos <- [INTERSECTION,UNION]
- ]
+mergeFuns = [ (show pos,pos)
+ | pos <- [INTERSECTION,UNION]
+ ]
diff --git a/HpcLexer.hs b/HpcLexer.hs
index feeb35a8ff6bcfb2a3b1cc7afe025522187c14f6..5610b7a89cb916936c7b3bc112ee82401cbc2c43 100644
--- a/HpcLexer.hs
+++ b/HpcLexer.hs
@@ -2,13 +2,13 @@ module HpcLexer where
import Data.Char
-data Token
- = ID String
+data Token
+ = ID String
| SYM Char
| INT Int
| STR String
- | CAT String
- deriving (Eq,Show)
+ | CAT String
+ deriving (Eq,Show)
initLexer :: String -> [Token]
initLexer str = [ t | (_,_,t) <- lexer str 1 1 ]
@@ -18,7 +18,7 @@ lexer (c:cs) line column
| c == '\n' = lexer cs (succ line) 1
| c == '\"' = lexerSTR cs line (succ column)
| c == '[' = lexerCAT cs "" line (succ column)
- | c `elem` "{};-:"
+ | c `elem` "{};-:"
= (line,column,SYM c) : lexer cs line (succ column)
| isSpace c = lexer cs line (succ column)
| isAlpha c = lexerKW cs [c] line (succ column)
@@ -54,4 +54,4 @@ test :: IO ()
test = do
t <- readFile "EXAMPLE.tc"
print (initLexer t)
-
+
diff --git a/HpcOverlay.hs b/HpcOverlay.hs
index a074d6c7faafd9d7e78ba5135d683bd717d4d91b..d5566aa6aebb5d1019f74f40812ce3ee4a24bf16 100644
--- a/HpcOverlay.hs
+++ b/HpcOverlay.hs
@@ -10,23 +10,23 @@ import qualified Data.Map as Map
import Data.Tree
overlay_options :: FlagOptSeq
-overlay_options
+overlay_options
= srcDirOpt
. hpcDirOpt
. outputOpt
overlay_plugin :: Plugin
overlay_plugin = Plugin { name = "overlay"
- , usage = "[OPTION] .. <OVERLAY_FILE> [<OVERLAY_FILE> [...]]"
- , options = overlay_options
- , summary = "Generate a .tix file from an overlay file"
- , implementation = overlay_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[OPTION] .. <OVERLAY_FILE> [<OVERLAY_FILE> [...]]"
+ , options = overlay_options
+ , summary = "Generate a .tix file from an overlay file"
+ , implementation = overlay_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
overlay_main :: Flags -> [String] -> IO ()
-overlay_main _ [] = hpcError overlay_plugin $ "no overlay file specified"
+overlay_main _ [] = hpcError overlay_plugin $ "no overlay file specified"
overlay_main flags files = do
specs <- mapM hpcParser files
let (Spec globals modules) = concatSpec specs
@@ -35,8 +35,8 @@ overlay_main flags files = do
mod_info <-
sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left modu)
- content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags)
- processModule modu content mix mod_spec globals
+ content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags)
+ processModule modu content mix mod_spec globals
| (modu, mod_spec) <- Map.toList modules1
]
@@ -48,12 +48,12 @@ overlay_main flags files = do
out -> writeFile out (show tix)
-processModule :: String -- ^ module name
- -> String -- ^ module contents
- -> Mix -- ^ mix entry for this module
- -> [Tick] -- ^ local ticks
- -> [ExprTick] -- ^ global ticks
- -> IO TixModule
+processModule :: String -- ^ module name
+ -> String -- ^ module contents
+ -> Mix -- ^ mix entry for this module
+ -> [Tick] -- ^ local ticks
+ -> [ExprTick] -- ^ global ticks
+ -> IO TixModule
processModule modName modContents (Mix _ _ hash _ entries) locals globals = do
let hsMap :: Map.Map Int String
@@ -76,8 +76,8 @@ processModule modName modContents (Mix _ _ hash _ entries) locals globals = do
plzTick pos (ExpBox _) (TickExpression _ match q _) =
qualifier pos q
&& case match of
- Nothing -> True
- Just str -> str == grabHpcPos hsMap pos
+ Nothing -> True
+ Just str -> str == grabHpcPos hsMap pos
plzTick _ _ _ = False
@@ -105,7 +105,7 @@ processModule modName modContents (Mix _ _ hash _ entries) locals globals = do
]
- --
+ --
let forest2 = addParentToList [] $ forest
-- putStrLn $ drawForest $ map (fmap show') $ forest2
@@ -136,14 +136,14 @@ qualifier :: HpcPos -> Maybe Qualifier -> Bool
qualifier _ Nothing = True
qualifier pos (Just (OnLine n)) = n == l1 && n == l2
where (l1,_,l2,_) = fromHpcPos pos
-qualifier pos (Just (AtPosition l1' c1' l2' c2'))
- = (l1', c1', l2', c2') == fromHpcPos pos
+qualifier pos (Just (AtPosition l1' c1' l2' c2'))
+ = (l1', c1', l2', c2') == fromHpcPos pos
concatSpec :: [Spec] -> Spec
-concatSpec = foldr
- (\ (Spec pre1 body1) (Spec pre2 body2)
- -> Spec (pre1 ++ pre2) (body1 ++ body2))
- (Spec [] [])
+concatSpec = foldr
+ (\ (Spec pre1 body1) (Spec pre2 body2)
+ -> Spec (pre1 ++ pre2) (body1 ++ body2))
+ (Spec [] [])
diff --git a/HpcReport.hs b/HpcReport.hs
index d3e3ef07232aba40553fb36ac67688c5f0a0176f..12403eb5b3860bf9bc703982c141ef578b2e3ffd 100644
--- a/HpcReport.hs
+++ b/HpcReport.hs
@@ -55,9 +55,9 @@ bbtPlus (BBT b1 tt1 ft1 bt1) (BBT b2 tt2 ft2 bt2) =
BBT (b1+b2) (tt1+tt2) (ft1+ft2) (bt1+bt2)
bbtPercentage :: String -> Bool -> BinBoxTixCounts -> String
-bbtPercentage s withdetail (BBT b tt ft bt) =
- showPercentage s bt b ++
- if withdetail && bt/=b then
+bbtPercentage s withdetail (BBT b tt ft bt) =
+ showPercentage s bt b ++
+ if withdetail && bt/=b then
detailFor tt "always True"++
detailFor ft "always False"++
detailFor (b-(tt+ft+bt)) "unevaluated"
@@ -160,11 +160,11 @@ modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do
modReport :: Flags -> TixModule -> IO ()
modReport hpcflags tix@(TixModule moduleName _ _ _) = do
mi <- modInfo hpcflags False tix
- if xmlOutput hpcflags
+ if xmlOutput hpcflags
then putStrLn $ " <module name = " ++ show moduleName ++ ">"
else putStrLn ("-----<module "++moduleName++">-----")
printModInfo hpcflags mi
- if xmlOutput hpcflags
+ if xmlOutput hpcflags
then putStrLn $ " </module>"
else return ()
@@ -193,7 +193,7 @@ modDecList :: Flags -> ModInfo -> IO ()
modDecList hpcflags mi0 =
when (decList hpcflags && someDecsUnused mi0) $ do
putStrLn "unused declarations:"
- mapM_ showDecPath (sort (decPaths mi0))
+ mapM_ showDecPath (sort (decPaths mi0))
where
someDecsUnused mi = tixCount (top mi) < boxCount (top mi) ||
tixCount (loc mi) < boxCount (loc mi)
@@ -202,39 +202,39 @@ modDecList hpcflags mi0 =
report_plugin :: Plugin
report_plugin = Plugin { name = "report"
- , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
- , options = report_options
- , summary = "Output textual report about program coverage"
- , implementation = report_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
+ , options = report_options
+ , summary = "Output textual report about program coverage"
+ , implementation = report_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
report_main :: Flags -> [String] -> IO ()
report_main hpcflags (progName:mods) = do
- let hpcflags1 = hpcflags
- { includeMods = Set.fromList mods
- `Set.union`
- includeMods hpcflags }
- let prog = getTixFileName $ progName
- tix <- readTix prog
+ let hpcflags1 = hpcflags
+ { includeMods = Set.fromList mods
+ `Set.union`
+ includeMods hpcflags }
+ let prog = getTixFileName $ progName
+ tix <- readTix prog
case tix of
Just (Tix tickCounts) ->
- makeReport hpcflags1 progName
- $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2)
- $ [ tix'
- | tix'@(TixModule m _ _ _) <- tickCounts
- , allowModule hpcflags1 m
- ]
+ makeReport hpcflags1 progName
+ $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2)
+ $ [ tix'
+ | tix'@(TixModule m _ _ _) <- tickCounts
+ , allowModule hpcflags1 m
+ ]
Nothing -> hpcError report_plugin $ "unable to find tix file for:" ++ progName
-report_main _ [] =
- hpcError report_plugin $ "no .tix file or executable name specified"
+report_main _ [] =
+ hpcError report_plugin $ "no .tix file or executable name specified"
makeReport :: Flags -> String -> [TixModule] -> IO ()
makeReport hpcflags progName modTcs | xmlOutput hpcflags = do
putStrLn $ "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
putStrLn $ "<coverage name=" ++ show progName ++ ">"
- if perModule hpcflags
+ if perModule hpcflags
then mapM_ (modReport hpcflags) modTcs
else return ()
mis <- mapM (modInfo hpcflags True) modTcs
@@ -250,11 +250,11 @@ makeReport hpcflags _ modTcs =
printModInfo hpcflags (foldr miPlus miZero mis)
element :: String -> [(String,String)] -> IO ()
-element tag attrs = putStrLn $
- " <" ++ tag ++ " "
- ++ unwords [ x ++ "=" ++ show y
- | (x,y) <- attrs
- ] ++ "/>"
+element tag attrs = putStrLn $
+ " <" ++ tag ++ " "
+ ++ unwords [ x ++ "=" ++ show y
+ | (x,y) <- attrs
+ ] ++ "/>"
xmlBT :: BoxTixCounts -> [(String, String)]
xmlBT (BT b t) = [("boxes",show b),("count",show t)]
@@ -265,7 +265,7 @@ xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),(
------------------------------------------------------------------------------
report_options :: FlagOptSeq
-report_options
+report_options
= perModuleOpt
. decListOpt
. excludeOpt
@@ -273,5 +273,5 @@ report_options
. srcDirOpt
. hpcDirOpt
. xmlOutputOpt
-
+
diff --git a/HpcShowTix.hs b/HpcShowTix.hs
index 7fd651550aee613841a919d893c4b3071d8aa108..354ee066b04c6d8d44ff4a85965769eb14948c07 100644
--- a/HpcShowTix.hs
+++ b/HpcShowTix.hs
@@ -8,7 +8,7 @@ import HpcFlags
import qualified Data.Set as Set
showtix_options :: FlagOptSeq
-showtix_options
+showtix_options
= excludeOpt
. includeOpt
. srcDirOpt
@@ -17,22 +17,22 @@ showtix_options
showtix_plugin :: Plugin
showtix_plugin = Plugin { name = "show"
- , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
- , options = showtix_options
- , summary = "Show .tix file in readable, verbose format"
- , implementation = showtix_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
+ , options = showtix_options
+ , summary = "Show .tix file in readable, verbose format"
+ , implementation = showtix_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
showtix_main :: Flags -> [String] -> IO ()
-showtix_main _ [] = hpcError showtix_plugin $ "no .tix file or executable name specified"
+showtix_main _ [] = hpcError showtix_plugin $ "no .tix file or executable name specified"
showtix_main flags (prog:modNames) = do
- let hpcflags1 = flags
- { includeMods = Set.fromList modNames
- `Set.union`
- includeMods flags }
+ let hpcflags1 = flags
+ { includeMods = Set.fromList modNames
+ `Set.union`
+ includeMods flags }
optTixs <- readTix (getTixFileName prog)
case optTixs of
@@ -42,12 +42,12 @@ showtix_main flags (prog:modNames) = do
[ do mix <- readMixWithFlags hpcflags1 (Right tix)
return $ (tix,mix)
| tix <- tixs
- , allowModule hpcflags1 (tixModuleName tix)
+ , allowModule hpcflags1 (tixModuleName tix)
]
-
- let rjust n str = take (n - length str) (repeat ' ') ++ str
- let ljust n str = str ++ take (n - length str) (repeat ' ')
-
+
+ let rjust n str = take (n - length str) (repeat ' ') ++ str
+ let ljust n str = str ++ take (n - length str) (repeat ' ')
+
sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++
rjust 10 (show count) ++ " " ++
ljust 20 modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab)
@@ -57,6 +57,6 @@ showtix_main flags (prog:modNames) = do
, Mix _file _timestamp _hash2 _tab entries
) <- tixs_mixs
]
-
+
return ()
diff --git a/Main.hs b/Main.hs
index cb1eec67786ca21136045436c8a4e128bbc4b598..3f1813f2430f8a69dc8c334621661fdc03157c21 100644
--- a/Main.hs
+++ b/Main.hs
@@ -17,38 +17,38 @@ import Paths_hpc_bin
helpList :: IO ()
helpList =
- putStrLn $
- "Usage: hpc COMMAND ...\n\n" ++
- section "Commands" help ++
- section "Reporting Coverage" reporting ++
- section "Processing Coverage files" processing ++
- section "Coverage Overlays" overlays ++
- section "Others" other ++
- ""
- where
+ putStrLn $
+ "Usage: hpc COMMAND ...\n\n" ++
+ section "Commands" help ++
+ section "Reporting Coverage" reporting ++
+ section "Processing Coverage files" processing ++
+ section "Coverage Overlays" overlays ++
+ section "Others" other ++
+ ""
+ where
help = ["help"]
reporting = ["report","markup"]
overlays = ["overlay","draft"]
processing = ["sum","combine","map"]
other = [ name hook
- | hook <- hooks
- , name hook `notElem`
- (concat [help,reporting,processing,overlays])
- ]
+ | hook <- hooks
+ , name hook `notElem`
+ (concat [help,reporting,processing,overlays])
+ ]
section :: String -> [String] -> String
section _ [] = ""
-section msg cmds = msg ++ ":\n"
+section msg cmds = msg ++ ":\n"
++ unlines [ take 14 (" " ++ cmd ++ repeat ' ') ++ summary hook
- | cmd <- cmds
- , hook <- hooks
- , name hook == cmd
- ]
+ | cmd <- cmds
+ , hook <- hooks
+ , name hook == cmd
+ ]
dispatch :: [String] -> IO ()
dispatch [] = do
- helpList
- exitWith ExitSuccess
+ helpList
+ exitWith ExitSuccess
dispatch (txt:args0) = do
case lookup txt hooks' of
Just plugin -> parse plugin args0
@@ -58,20 +58,20 @@ dispatch (txt:args0) = do
case getOpt Permute (options plugin []) args of
(_,_,errs) | not (null errs)
-> do putStrLn "hpc failed:"
- sequence_ [ putStr (" " ++ err)
- | err <- errs
- ]
- putStrLn $ "\n"
+ sequence_ [ putStr (" " ++ err)
+ | err <- errs
+ ]
+ putStrLn $ "\n"
command_usage plugin
- exitFailure
- (o,ns,_) -> do
- let flags = final_flags plugin
- $ foldr (.) id o
- $ init_flags plugin
- implementation plugin flags ns
+ exitFailure
+ (o,ns,_) -> do
+ let flags = final_flags plugin
+ $ foldr (.) id o
+ $ init_flags plugin
+ implementation plugin flags ns
main :: IO ()
-main = do
+main = do
args <- getArgs
dispatch args
@@ -79,15 +79,15 @@ main = do
hooks :: [Plugin]
hooks = [ help_plugin
- , report_plugin
- , markup_plugin
- , sum_plugin
- , combine_plugin
- , map_plugin
- , showtix_plugin
- , overlay_plugin
- , draft_plugin
- , version_plugin
+ , report_plugin
+ , markup_plugin
+ , sum_plugin
+ , combine_plugin
+ , map_plugin
+ , showtix_plugin
+ , overlay_plugin
+ , draft_plugin
+ , version_plugin
]
hooks' :: [(String, Plugin)]
@@ -97,26 +97,26 @@ hooks' = [ (name hook,hook) | hook <- hooks ]
help_plugin :: Plugin
help_plugin = Plugin { name = "help"
- , usage = "[<HPC_COMMAND>]"
- , summary = "Display help for hpc or a single command"
- , options = help_options
- , implementation = help_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = "[<HPC_COMMAND>]"
+ , summary = "Display help for hpc or a single command"
+ , options = help_options
+ , implementation = help_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
help_main :: Flags -> [String] -> IO ()
help_main _ [] = do
- helpList
- exitWith ExitSuccess
+ helpList
+ exitWith ExitSuccess
help_main _ (sub_txt:_) = do
case lookup sub_txt hooks' of
Nothing -> do
- putStrLn $ "no such hpc command : " ++ sub_txt
- exitFailure
+ putStrLn $ "no such hpc command : " ++ sub_txt
+ exitFailure
Just plugin' -> do
- command_usage plugin'
- exitWith ExitSuccess
+ command_usage plugin'
+ exitWith ExitSuccess
help_options :: FlagOptSeq
help_options = id
@@ -125,13 +125,13 @@ help_options = id
version_plugin :: Plugin
version_plugin = Plugin { name = "version"
- , usage = ""
- , summary = "Display version for hpc"
- , options = id
- , implementation = version_main
- , init_flags = default_flags
- , final_flags = default_final_flags
- }
+ , usage = ""
+ , summary = "Display version for hpc"
+ , options = id
+ , implementation = version_main
+ , init_flags = default_flags
+ , final_flags = default_final_flags
+ }
version_main :: Flags -> [String] -> IO ()
version_main _ _ = putStrLn ("hpc tools, version " ++ showVersion version)