5 import System.Console.GetOpt
6 import Data.Maybe ( fromMaybe )
7 import qualified HpcSet as Set
12 { outputFile :: String
13 , includeMods :: Set.Set String
14 , excludeMods :: Set.Set String
24 , altHighlight :: Bool
26 , combineFun :: CombineFun
32 , includeMods = Set.empty
33 , excludeMods = Set.empty
43 , altHighlight = False
49 -- We do this after reading flags, because the defaults
50 -- depends on if specific flags we used.
52 default_final_flags flags = flags
53 { hpcDirs = if null (hpcDirs flags)
56 , hsDirs = if null (hsDirs flags)
61 noArg :: String -> String -> (Flags -> Flags) -> OptDescr (Flags -> Flags)
62 noArg flag detail fn = Option [] [flag] (NoArg $ fn) detail
64 anArg :: String -> String -> String -> (String -> Flags -> Flags) -> OptDescr (Flags -> Flags)
65 anArg flag detail argtype fn = Option [] [flag] (ReqArg fn argtype) detail
67 infoArg :: String -> OptDescr (Flags -> Flags)
68 infoArg info = Option [] [] (NoArg $ id) info
70 excludeOpt = anArg "exclude" "exclude MODULE" "MODULE" $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
72 includeOpt = anArg "include" "include MODULE" "MODULE" $ \ a f -> f { includeMods = a `Set.insert` includeMods f }
73 hpcDirOpt = anArg "hpcdir" "path to .mix files (default .hpc)" "DIR"
74 $ \ a f -> f { hpcDirs = hpcDirs f ++ [a] }
75 hsDirOpt = anArg "hsdir" "path to .hs files (default .)" "DIR"
76 $ \ a f -> f { hsDirs = hsDirs f ++ [a] }
77 destDirOpt = anArg "destdir" "path to write output to" "DIR"
78 $ \ a f -> f { destDir = a }
79 outputOpt = anArg "output" "output FILE" "FILE" $ \ a f -> f { outputFile = a }
82 perModuleOpt = noArg "per-module" "show module level detail" $ \ f -> f { perModule = True }
83 decListOpt = noArg "dec-list" "show unused decls" $ \ f -> f { decList = True }
84 xmlOutputOpt = noArg "xml-output" "show output in XML" $ \ f -> f { xmlOutput = True }
85 funTotalsOpt = noArg "fun-entry-count" "show top-level function entry counts"
86 $ \ f -> f { funTotals = True }
88 = noArg "highlight-covered" "highlight covered code, rather that code gaps"
89 $ \ f -> f { altHighlight = True }
91 combineFunOpt = anArg "combine"
92 "combine .tix files with join function, default = ADD" "FUNCTION"
93 $ \ a f -> case reads (map toUpper a) of
94 [(c,"")] -> f { combineFun = c }
95 _ -> error $ "no such combine function : " ++ a
96 combineFunOptInfo = infoArg
97 $ "FUNCTION = " ++ foldr1 (\ a b -> a ++ " | " ++ b) (map fst combineFuns)
99 postInvertOpt = noArg "post-invert" "invert output; ticked becomes unticked, unticked becomes ticked"
100 $ \ f -> f { funTotals = True }
101 -------------------------------------------------------------------------------
103 command_usage plugin =
105 "Usage: hpc " ++ (name plugin) ++ " " ++
107 if null (options plugin)
109 else usageInfo "\n\nOptions:\n" (options plugin)
111 -------------------------------------------------------------------------------
113 data Plugin = Plugin { name :: String
115 , options :: [OptDescr (Flags -> Flags)]
117 , implementation :: Flags -> [String] -> IO ()
118 , init_flags :: Flags
119 , final_flags :: Flags -> Flags
122 ------------------------------------------------------------------------------
124 -- filterModules takes a list of candidate modules,
126 -- * excludes the excluded modules
127 -- * includes the rest if there are no explicity included modules
128 -- * otherwise, accepts just the included modules.
130 allowModule :: Flags -> String -> Bool
131 allowModule flags mod
132 | mod `Set.member` excludeMods flags = False
133 | Set.null (includeMods flags) = True
134 | mod `Set.member` includeMods flags = True
137 filterTix :: Flags -> Tix -> Tix
138 filterTix flags (Tix tixs) =
139 Tix $ filter (allowModule flags . tixModuleName) tixs
141 ------------------------------------------------------------------------------
142 -- HpcCombine specifics
144 data CombineFun = ADD | DIFF | SUB | ZERO
145 deriving (Eq,Show, Read, Enum)
147 combineFuns = [ (show comb,comb)
148 | comb <- [ADD .. ZERO]