Make some utils -Wall clean
authorIan Lynagh <igloo@earth.li>
Thu, 21 Aug 2008 15:39:14 +0000 (15:39 +0000)
committerIan Lynagh <igloo@earth.li>
Thu, 21 Aug 2008 15:39:14 +0000 (15:39 +0000)
13 files changed:
utils/ghc-pkg/Main.hs
utils/hpc/Hpc.hs
utils/hpc/HpcCombine.hs
utils/hpc/HpcDraft.hs
utils/hpc/HpcFlags.hs
utils/hpc/HpcLexer.hs
utils/hpc/HpcMap.hs
utils/hpc/HpcMarkup.hs
utils/hpc/HpcOverlay.hs
utils/hpc/HpcReport.hs
utils/hpc/HpcShowTix.hs
utils/hpc/HpcUtils.hs
utils/installPackage/installPackage.hs

index e204dbc..4294ff7 100644 (file)
@@ -54,7 +54,7 @@ import GHC.ConsoleHandler
 import System.Posix
 #endif
 
-import IO ( isPermissionError, isDoesNotExistError )
+import IO ( isPermissionError )
 
 #if defined(GLOB)
 import System.Process(runInteractiveCommand)
@@ -409,7 +409,7 @@ getPkgDatabases modify my_flags = do
                    user_conf = dir </> subdir </> "package.conf"
                user_exists <- doesFileExist user_conf
                return (Just (user_conf,user_exists))
-       Left ex ->
+       Left _ ->
                return Nothing
 
   -- If the user database doesn't exist, and this command isn't a
@@ -434,7 +434,7 @@ getPkgDatabases modify my_flags = do
 
   let db_flags = [ f | Just f <- map is_db_flag my_flags ]
          where is_db_flag FlagUser
-                      | Just (user_conf,user_exists) <- mb_user_conf 
+                      | Just (user_conf, _user_exists) <- mb_user_conf 
                       = Just user_conf
                is_db_flag FlagGlobal     = Just virt_global_conf
                is_db_flag (FlagConfig f) = Just f
@@ -550,7 +550,7 @@ modifyPackage
   -> Force
   -> IO ()
 modifyPackage fn pkgid my_flags force = do
-  (db_stack, Just to_modify) <- getPkgDatabases True{-modify-} my_flags
+  (db_stack, Just _to_modify) <- getPkgDatabases True{-modify-} my_flags
   ((db_name, pkgs), ps) <- fmap head $ findPackagesByDB db_stack (Id pkgid)
 --  let ((db_name, pkgs) : rest_of_stack) = db_stack
 --  ps <- findPackages [(db_name,pkgs)] (Id pkgid)
@@ -563,7 +563,8 @@ modifyPackage fn pkgid my_flags force = do
 
   let
       old_broken = brokenPackages (allPackagesInStack db_stack)
-      rest_of_stack = [ (nm,pkgs) | (nm,pkgs) <- db_stack, nm /= db_name ]
+      rest_of_stack = [ (nm, mypkgs)
+                      | (nm, mypkgs) <- db_stack, nm /= db_name ]
       new_stack = (db_name,new_config) : rest_of_stack
       new_broken = map package (brokenPackages (allPackagesInStack new_stack))
       newly_broken = filter (`notElem` map package old_broken) new_broken
@@ -666,7 +667,7 @@ findPackagesByDB :: PackageDBStack -> PackageArg
                  -> IO [(NamedPackageDB, [InstalledPackageInfo])]
 findPackagesByDB db_stack pkgarg
   = case [ (db, matched)
-         | db@(db_name,pkgs) <- db_stack,
+         | db@(_, pkgs) <- db_stack,
            let matched = filter (pkgarg `matchesPkg`) pkgs,
            not (null matched) ] of
         [] -> die ("cannot find package " ++ pkg_msg pkgarg)
@@ -783,8 +784,8 @@ brokenPackages pkgs = go [] pkgs
  where
    go avail not_avail =
      case partition (depsAvailable avail) not_avail of
-        ([],        not_avail) -> not_avail
-        (new_avail, not_avail) -> go (new_avail ++ avail) not_avail
+        ([],        not_avail') -> not_avail'
+        (new_avail, not_avail') -> go (new_avail ++ avail) not_avail'
 
    depsAvailable :: [InstalledPackageInfo] -> InstalledPackageInfo
                  -> Bool
@@ -1141,12 +1142,14 @@ catchIO io handler = io `Exception.catch` handler'
           handler' e                           = Exception.throw e
 #endif
 
+#if mingw32_HOST_OS || mingw32_TARGET_OS
 throwIOIO :: Exception.IOException -> IO a
 #if __GLASGOW_HASKELL__ >= 609
 throwIOIO = Exception.throwIO
 #else
 throwIOIO ioe = Exception.throwIO (Exception.IOException ioe)
 #endif
+#endif
 
 catchError :: IO a -> (String -> IO a) -> IO a
 #if __GLASGOW_HASKELL__ >= 609
index 68fe87f..da859d0 100644 (file)
@@ -1,7 +1,6 @@
 -- (c) 2007 Andy Gill
 
 -- Main driver for Hpc
-import Trace.Hpc.Tix
 import HpcFlags
 import System.Environment
 import System.Exit
@@ -36,7 +35,7 @@ helpList =
                ]
 
 section :: String -> [String] -> String
-section msg []   = ""
+section _   []   = ""
 section msg cmds = msg ++ ":\n" 
         ++ unlines [ take 14 ("  " ++ cmd ++ repeat ' ') ++ summary hook
                   | cmd <- cmds
@@ -48,10 +47,10 @@ dispatch :: [String] -> IO ()
 dispatch [] = do
             helpList
             exitWith ExitSuccess
-dispatch (txt:args) = do
+dispatch (txt:args0) = do
      case lookup txt hooks' of
-       Just plugin -> parse plugin args
-       _ -> parse help_plugin (txt:args)
+       Just plugin -> parse plugin args0
+       _ -> parse help_plugin (txt:args0)
   where
      parse plugin args =
               case getOpt Permute (options plugin []) args of
@@ -68,12 +67,15 @@ dispatch (txt:args) = do
                                   $ foldr (.) id o 
                                   $ init_flags plugin
                         implementation plugin flags ns
+
+main :: IO ()
 main = do 
  args <- getArgs
  dispatch args
 
 ------------------------------------------------------------------------------
 
+hooks :: [Plugin]
 hooks = [ help_plugin
         , report_plugin 
        , markup_plugin
@@ -86,10 +88,12 @@ hooks = [ help_plugin
        , version_plugin
         ]
 
+hooks' :: [(String, Plugin)]
 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"
@@ -99,10 +103,11 @@ help_plugin = Plugin { name = "help"
                   , final_flags = default_final_flags
                   }
 
-help_main flags [] = do
+help_main :: Flags -> [String] -> IO ()
+help_main _ [] = do
            helpList
            exitWith ExitSuccess            
-help_main flags (sub_txt:_) = do
+help_main _ (sub_txt:_) = do
     case lookup sub_txt hooks' of
       Nothing -> do
          putStrLn $ "no such hpc command : " ++ sub_txt
@@ -111,10 +116,12 @@ help_main flags (sub_txt:_) = do
          command_usage plugin'
          exitWith ExitSuccess
 
+help_options :: FlagOptSeq
 help_options   = id
 
 ------------------------------------------------------------------------------
 
+version_plugin :: Plugin
 version_plugin = Plugin { name = "version"
                   , usage = ""
                   , summary = "Display version for hpc"
@@ -124,6 +131,7 @@ version_plugin = Plugin { name = "version"
                   , final_flags = default_final_flags
                   }
 
+version_main :: Flags -> [String] -> IO ()
 version_main _ _ = putStrLn $ "hpc tools, version 0.6"
 
 
index 3c0ac0d..57c698a 100644 (file)
@@ -13,15 +13,16 @@ import HpcFlags
 import Control.Monad
 import qualified HpcSet as Set
 import qualified HpcMap as Map
-import System.Environment
 
 ------------------------------------------------------------------------------
+sum_options :: FlagOptSeq
 sum_options 
         = excludeOpt
         . includeOpt
         . outputOpt
        . unionModuleOpt 
 
+sum_plugin :: Plugin
 sum_plugin = Plugin { name = "sum"
                       , usage = "[OPTION] .. <TIX_FILE> [<TIX_FILE> [<TIX_FILE> ..]]" 
                       , options = sum_options 
@@ -31,6 +32,7 @@ sum_plugin = Plugin { name = "sum"
                       , final_flags = default_final_flags
                       }
 
+combine_options :: FlagOptSeq
 combine_options 
         = excludeOpt
         . includeOpt
@@ -39,6 +41,7 @@ combine_options
         . combineFunOptInfo
        . unionModuleOpt 
 
+combine_plugin :: Plugin
 combine_plugin = Plugin { name = "combine"
                       , usage = "[OPTION] .. <TIX_FILE> <TIX_FILE>" 
                       , options = combine_options 
@@ -48,6 +51,7 @@ combine_plugin = Plugin { name = "combine"
                       , final_flags = default_final_flags
                       }
 
+map_options :: FlagOptSeq
 map_options 
         = excludeOpt
         . includeOpt
@@ -56,6 +60,7 @@ map_options
         . mapFunOptInfo
        . unionModuleOpt 
 
+map_plugin :: Plugin
 map_plugin = Plugin { name = "map"
                       , usage = "[OPTION] .. <TIX_FILE> "
                       , options = map_options 
@@ -68,7 +73,7 @@ map_plugin = Plugin { name = "map"
 ------------------------------------------------------------------------------
 
 sum_main :: Flags -> [String] -> IO ()
-sum_main flags [] = 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
 
@@ -95,7 +100,7 @@ combine_main flags [first_file,second_file] = do
   case outputFile flags of
     "-" -> putStrLn (show tix)
     out -> writeTix out tix
-combine_main flags [] = hpcError combine_plugin $ "need exactly two .tix files to combine"
+combine_main _     _ = hpcError combine_plugin $ "need exactly two .tix files to combine"
 
 map_main :: Flags -> [String] -> IO ()
 map_main flags [first_file] = do
@@ -111,8 +116,8 @@ map_main flags [first_file] = do
   case outputFile flags of
     "-" -> putStrLn (show tix')
     out -> writeTix out tix'
-map_main flags [] = hpcError map_plugin $ "no .tix file specified" 
-map_main flags _  = 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
index 36e7a60..791537b 100644 (file)
@@ -9,11 +9,11 @@ import HpcFlags
 import Control.Monad
 import qualified HpcSet as Set
 import qualified HpcMap as Map
-import System.Environment
 import HpcUtils
 import Data.Tree
 
 ------------------------------------------------------------------------------
+draft_options :: FlagOptSeq
 draft_options 
         = excludeOpt
         . includeOpt
@@ -21,6 +21,7 @@ draft_options
         . hpcDirOpt
         . outputOpt
                 
+draft_plugin :: Plugin
 draft_plugin = Plugin { name = "draft"
                       , usage = "[OPTION] .. <TIX_FILE>" 
                       , options = draft_options 
@@ -33,6 +34,7 @@ draft_plugin = Plugin { name = "draft"
 ------------------------------------------------------------------------------
 
 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 
@@ -55,15 +57,14 @@ draft_main hpcflags (progName:mods) = do
 
 makeDraft :: Flags -> TixModule -> IO String
 makeDraft hpcflags tix = do 
-  let mod  = tixModuleName tix
-      hash = tixModuleHash tix
+  let modu = tixModuleName tix
       tixs = tixModuleTixs tix
 
-  mix@(Mix filepath timestamp hash tabstop entries) <- readMixWithFlags hpcflags (Right tix)
+  (Mix filepath _ _ _ entries) <- readMixWithFlags hpcflags (Right tix)
 
   let forest = createMixEntryDom 
-              [ (span,(box,v > 0))
-              | ((span,box),v) <- zip entries tixs
+              [ (srcspan,(box,v > 0))
+              | ((srcspan,box),v) <- zip entries tixs
               ]
 
 --  let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span)
@@ -95,22 +96,25 @@ makeDraft hpcflags tix = do
           where
                   txt = grabHpcPos hsMap pos
 
-      showPleaseTick d (TickInside [str] pos pleases) =
+      showPleaseTick d (TickInside [str] _ pleases) =
                      spaces d ++ "inside \"" ++ str ++ "\" {\n" ++
                      showPleaseTicks (d + 2) pleases ++
                      spaces d ++ "}"
 
+      showPleaseTick _ (TickInside _ _ _)
+          = error "showPleaseTick: Unhandled case TickInside"
+
       showPleaseTicks d pleases = unlines (map (showPleaseTick d) pleases)
 
       spaces d = take d (repeat ' ')
 
-  return $ "module " ++ show (fixPackageSuffix mod) ++ " {\n" ++
+  return $ "module " ++ show (fixPackageSuffix modu) ++ " {\n" ++
          showPleaseTicks 2 non_ticked ++ "}"
 
 fixPackageSuffix :: String -> String
-fixPackageSuffix mod = case span (/= '/') mod of
-                         (before,'/':after) -> before ++ ":" ++ after
-                         _                  -> mod
+fixPackageSuffix modu = case span (/= '/') modu of
+                        (before,'/':after) -> before ++ ":" ++ after
+                        _                  -> modu
 
 data PleaseTick
    = TickFun [String] HpcPos
@@ -118,6 +122,8 @@ data PleaseTick
    | TickInside [String] HpcPos [PleaseTick]
     deriving Show
 
+mkTickInside :: [String] -> HpcPos -> [PleaseTick]
+             -> [PleaseTick] -> [PleaseTick]
 mkTickInside _ _ []        = id
 mkTickInside nm pos inside = (TickInside nm pos inside :)
 
@@ -127,11 +133,11 @@ findNotTickedFromTree (Node (pos,(TopLevelBox nm,False):_) _)
   = [ TickFun nm pos ]
 findNotTickedFromTree (Node (pos,(LocalBox nm,False):_) _)
   = [ TickFun nm pos ]
-findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):others) children)
+findNotTickedFromTree (Node (pos,(TopLevelBox nm,True):_) children)
   = mkTickInside nm pos (findNotTickedFromList children) []                           
 findNotTickedFromTree (Node (pos,_:others) children) = 
                       findNotTickedFromTree (Node (pos,others) children)
-findNotTickedFromTree (Node (pos,[]) children) = findNotTickedFromList children
+findNotTickedFromTree (Node (_, []) children) = findNotTickedFromList children
 
 findNotTickedFromList :: [MixEntryDom [(BoxLabel,Bool)]] -> [PleaseTick]
 findNotTickedFromList = concatMap findNotTickedFromTree
index b445367..30cc401 100644 (file)
@@ -3,7 +3,6 @@
 module HpcFlags where
 
 import System.Console.GetOpt
-import Data.Maybe ( fromMaybe )
 import qualified HpcSet as Set
 import Data.Char
 import Trace.Hpc.Tix
@@ -30,6 +29,7 @@ data Flags = Flags
   , mergeModule                :: MergeFun     -- module-wise merge
   }
 
+default_flags :: Flags
 default_flags = Flags
   { outputFile         = "-"
   , includeMods         = Set.empty
@@ -54,6 +54,7 @@ default_flags = Flags
 -- We do this after reading flags, because the defaults
 -- depends on if specific flags we used.
 
+default_final_flags :: Flags -> Flags
 default_final_flags flags = flags 
   { srcDirs = if null (srcDirs flags)
              then ["."]
@@ -71,6 +72,10 @@ anArg flag detail argtype fn = (:) $ Option [] [flag] (ReqArg fn argtype) detail
 infoArg :: String -> FlagOptSeq
 infoArg info = (:) $ Option [] [] (NoArg $ id) info
 
+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]"  
                 $ \ a f -> f { excludeMods = a `Set.insert` excludeMods f }
 
@@ -125,12 +130,13 @@ unionModuleOpt = noArg "union"
 -------------------------------------------------------------------------------
 
 readMixWithFlags :: Flags -> Either String TixModule -> IO Mix
-readMixWithFlags flags mod = readMix [ dir ++  "/" ++ hpcDir flags
-                                     | dir <- srcDirs flags 
-                                     ] mod
+readMixWithFlags flags modu = readMix [ dir ++  "/" ++ hpcDir flags
+                                      | dir <- srcDirs flags 
+                                      ] modu
 
 -------------------------------------------------------------------------------
 
+command_usage :: Plugin -> IO ()
 command_usage plugin = 
   putStrLn $
                                       "Usage: hpc " ++ (name plugin) ++ " " ++ 
@@ -213,9 +219,10 @@ data PostFun = ID | INV | ZERO
 thePostFun :: PostFun -> Integer -> Integer
 thePostFun ID   x = x
 thePostFun INV  0 = 1
-thePostFun INV  n = 0
-thePostFun ZERO x = 0
+thePostFun INV  _ = 0
+thePostFun ZERO _ = 0
 
+postFuns :: [(String, PostFun)]
 postFuns = [ (show pos,pos) 
             | pos <- [ID .. ZERO]
           ]
@@ -228,6 +235,7 @@ theMergeFun :: (Ord a) => MergeFun -> Set.Set a -> Set.Set a -> Set.Set a
 theMergeFun INTERSECTION = Set.intersection
 theMergeFun UNION        = Set.union
 
+mergeFuns :: [(String, MergeFun)]
 mergeFuns = [ (show pos,pos) 
             | pos <- [INTERSECTION,UNION]
           ]
index 3d1a640..db886a3 100644 (file)
@@ -24,28 +24,33 @@ lexer (c:cs) line column
   | isAlpha c = lexerKW  cs [c] line (succ column)
   | isDigit c = lexerINT cs [c] line (succ column)
   | otherwise = error "lexer failure"
-lexer [] line colunm = []
+lexer [] _ _ = []
 
+lexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)]
 lexerKW  (c:cs) s line column
   | isAlpha c = lexerKW cs (s ++ [c]) line (succ column)
 lexerKW  other s line column = (line,column,ID s) : lexer other line column
 
+lexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
 lexerINT  (c:cs) s line column
   | isDigit c = lexerINT cs (s ++ [c]) line (succ column)
 lexerINT  other s line column = (line,column,INT (read s)) : lexer other line column
 
 -- not technically correct for the new column count, but a good approximation.
+lexerSTR :: String -> Int -> Int -> [(Int,Int,Token)]
 lexerSTR cs line column
   = case lex ('"' : cs) of
       [(str,rest)] -> (line,succ column,STR (read str))
                    : lexer rest line (length (show str) + column + 1)
       _ -> error "bad string"
 
+lexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
 lexerCAT (c:cs) s line column
   | c == ']'  =  (line,column,CAT s) : lexer cs line (succ column)
   | otherwise = lexerCAT cs (s ++ [c]) line (succ column)
-lexerCAT  other s line column = error "lexer failure in CAT"
+lexerCAT  [] _ _ _ = error "lexer failure in CAT"
 
+test :: IO ()
 test = do
           t <- readFile "EXAMPLE.tc"
           print (initLexer t)
index b1a0f2f..873fc50 100644 (file)
@@ -10,6 +10,7 @@ import qualified Data.Map as Map
 lookup :: Ord key => key -> Map key elt -> Maybe elt
 fromList :: Ord key => [(key,elt)] -> Map key elt
 fromListWith :: Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
+toList :: Ord key => Map key elt -> [(key,elt)]
 
 #if __GLASGOW_HASKELL__ < 604
 type Map key elt = Map.FiniteMap key elt
index a40c297..f78a4af 100644 (file)
@@ -12,7 +12,6 @@ import Trace.Hpc.Util
 import HpcFlags
 import HpcUtils
 
-import System.Environment
 import System.Directory
 import Data.List
 import Data.Maybe(fromJust)
@@ -22,6 +21,7 @@ import qualified HpcSet as Set
 
 ------------------------------------------------------------------------------
 
+markup_options :: FlagOptSeq
 markup_options 
         = excludeOpt
         . includeOpt
@@ -30,7 +30,8 @@ markup_options
         . funTotalsOpt
         . altHighlightOpt
         . destDirOpt
-                
+
+markup_plugin :: Plugin
 markup_plugin = Plugin { name = "markup"
                       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]" 
                       , options = markup_options 
@@ -75,14 +76,14 @@ markup_main flags (prog:modNames) = do
       index_alt  = "hpc_index_alt"
       index_exp  = "hpc_index_exp"
 
-  let writeSummary name cmp = do
+  let writeSummary filename cmp = do
         let mods' = sortBy cmp mods
 
 
 
    
-        putStrLn $ "Writing: " ++ (name ++ ".html")
-        writeFile (dest_dir ++ "/" ++ name ++ ".html") $ 
+        putStrLn $ "Writing: " ++ (filename ++ ".html")
+        writeFile (dest_dir ++ "/" ++ filename ++ ".html") $ 
            "<html>" ++
            "<style type=\"text/css\">" ++
            "table.bar { background-color: #f25913; }\n" ++
@@ -107,13 +108,13 @@ markup_main flags (prog:modNames) = do
            "<th>%</th>" ++
            "<th colspan=2>covered / total</th>" ++
            "</tr>" ++
-           concat [ showModuleSummary (modName,fileName,summary)
-                  | (modName,fileName,summary) <- mods'
+           concat [ showModuleSummary (modName,fileName,modSummary)
+                  | (modName,fileName,modSummary) <- mods'
                   ] ++
            "<tr></tr>" ++
            showTotalSummary (mconcat
-                                [ summary 
-                                | (_,_,summary) <- mods'
+                                [ modSummary 
+                                | (_,_,modSummary) <- mods'
                                 ])
                   ++ "</table></html>\n"
 
@@ -132,7 +133,8 @@ markup_main flags (prog:modNames) = do
                (percent (expTicked s1) (expTotal s1))
 
 
-markup_main flags [] = hpcError markup_plugin $ "no .tix file or executable name specified" 
+markup_main _ []
+    = hpcError markup_plugin $ "no .tix file or executable name specified" 
 
 genHtmlFromMod
   :: String
@@ -145,7 +147,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
   let theHsPath = srcDirs flags
   let modName0 = tixModuleName tix 
 
-  (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags (Right tix)
+  (Mix origFile _ _ tabStop mix') <- readMixWithFlags flags (Right tix)
 
   let arr_tix :: Array Int Integer
       arr_tix = listArray (0,length (tixModuleTixs tix) - 1)
@@ -176,7 +178,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
              ]
 
 
-  let summary = foldr (.) id 
+  let modSummary = foldr (.) id 
             [ \ st -> 
               case boxLabel of
                 ExpBox False
@@ -228,7 +230,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
                     "</style>",
                     "<pre>"] ++ addLines content' ++ "\n</pre>\n</html>\n";
 
-  summary `seq` return (modName0,fileName,summary)
+  modSummary `seq` return (modName0,fileName,modSummary)
 
 data Loc = Loc !Int !Int
         deriving (Eq,Ord,Show)
@@ -288,8 +290,8 @@ addMarkup tabStop cs loc os ((t1,t2,tik0):ticks) | loc == t1 =
   where
 
   addTo (t,tik) []             = [(t,tik)]
-  addTo (t,tik) ((t',tik'):xs) | t <= t' = (t,tik):(t',tik'):xs
-                              | t > t'  = (t',tik):(t',tik'):xs 
+  addTo (t,tik) ((t',tik'):xs) | t <= t'   = (t,tik):(t',tik'):xs
+                              | otherwise = (t',tik):(t',tik'):xs 
 
 addMarkup tabStop0 cs loc os ((t1,_t2,_tik):ticks) | loc > t1 =
          -- throw away this tick, because it is from a previous place ??
@@ -392,22 +394,22 @@ data ModuleSummary = ModuleSummary
 
 
 showModuleSummary :: (String, String, ModuleSummary) -> String
-showModuleSummary (modName,fileName,summary) =
+showModuleSummary (modName,fileName,modSummary) =
   "<tr>\n" ++ 
   "<td>&nbsp;&nbsp;<tt>module <a href=\"" ++ fileName ++ "\">" 
                              ++ modName ++ "</a></tt></td>\n" ++
-   showSummary (topFunTicked summary) (topFunTotal summary) ++
-   showSummary (altTicked summary) (altTotal summary) ++
-   showSummary (expTicked summary) (expTotal summary) ++
+   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++
+   showSummary (altTicked modSummary) (altTotal modSummary) ++
+   showSummary (expTicked modSummary) (expTotal modSummary) ++
   "</tr>\n"
 
 showTotalSummary :: ModuleSummary -> String
-showTotalSummary summary =
+showTotalSummary modSummary =
   "<tr style=\"background: #e0e0e0\">\n" ++ 
   "<th align=left>&nbsp;&nbsp;Program Coverage Total</tt></th>\n" ++
-   showSummary (topFunTicked summary) (topFunTotal summary) ++
-   showSummary (altTicked summary) (altTotal summary) ++
-   showSummary (expTicked summary) (expTotal summary) ++
+   showSummary (topFunTicked modSummary) (topFunTotal modSummary) ++
+   showSummary (altTicked modSummary) (altTotal modSummary) ++
+   showSummary (expTicked modSummary) (expTotal modSummary) ++
   "</tr>\n"
 
 showSummary :: (Integral t) => t -> t -> String
@@ -422,7 +424,7 @@ showSummary ticked total =
      where
         showP Nothing = "-&nbsp;"
         showP (Just x) = show x ++ "%"
-        bar 0 inner = bar 100 "invbar"
+        bar 0 _     = bar 100 "invbar"
         bar w inner = "<table cellpadding=0 cellspacing=0 width=\"100\" class=\"bar\">" ++
                         "<tr><td><table cellpadding=0 cellspacing=0 width=\"" ++ show w ++ "%\">" ++
                              "<tr><td height=12 class=" ++ show inner ++ "></td></tr>" ++
index 76cc76e..e415578 100644 (file)
@@ -9,11 +9,13 @@ import Trace.Hpc.Util
 import HpcMap as Map
 import Data.Tree
 
+overlay_options :: FlagOptSeq
 overlay_options 
         = srcDirOpt
         . hpcDirOpt
         . outputOpt
 
+overlay_plugin :: Plugin
 overlay_plugin = Plugin { name = "overlay"
                       , usage = "[OPTION] .. <OVERLAY_FILE> [<OVERLAY_FILE> [...]]" 
                       , options = overlay_options 
@@ -23,19 +25,19 @@ overlay_plugin = Plugin { name = "overlay"
                       , final_flags = default_final_flags
                       }
 
-
-overlay_main flags [] = hpcError overlay_plugin $ "no overlay file specified" 
+overlay_main :: Flags -> [String] -> IO ()
+overlay_main _     [] = hpcError overlay_plugin $ "no overlay file specified" 
 overlay_main flags files = do
   specs <- mapM hpcParser files
-  let spec@(Spec globals modules) = concatSpec specs
+  let (Spec globals modules) = concatSpec specs
 
   let modules1 = Map.fromListWith (++) [ (m,info) | (m,info) <- modules ]
 
   mod_info <-
-     sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left mod)
+     sequence [ do mix@(Mix origFile _ _ _ _) <- readMixWithFlags flags (Left modu)
                   content <- readFileFromPath (hpcError overlay_plugin) origFile (srcDirs flags)
-                  processModule mod content mix mod_spec globals
-              | (mod,mod_spec) <- Map.toList modules1
+                  processModule modu content mix mod_spec globals
+              | (modu, mod_spec) <- Map.toList modules1
               ]
 
 
@@ -52,7 +54,7 @@ processModule :: String               -- ^ module name
               -> [Tick]        -- ^ local ticks
               -> [ExprTick]    -- ^ global ticks
               -> IO TixModule 
-processModule modName modContents (Mix filepath timestamp hash tabstop entries) locals globals = do
+processModule modName modContents (Mix _ _ hash _ entries) locals globals = do
 
    let hsMap :: Map.Map Int String
        hsMap = Map.fromList (zip [1..] $ lines modContents)
@@ -71,7 +73,7 @@ processModule modName modContents (Mix filepath timestamp hash tabstop entries)
 
    -- TODO: rename plzTick => plzExprTick, plzTopPick => plzTick
    let plzTick :: HpcPos -> BoxLabel -> ExprTick -> Bool
-       plzTick pos (ExpBox _) (TickExpression _ match q g)  =
+       plzTick pos (ExpBox _) (TickExpression _ match q _)  =
                      qualifier pos q
                   && case match of
                        Nothing -> True
@@ -81,7 +83,7 @@ processModule modName modContents (Mix filepath timestamp hash tabstop entries)
 
        plzTopTick :: HpcPos -> BoxLabel -> Tick -> Bool
        plzTopTick pos label  (ExprTick ignore)           = plzTick pos label ignore
-       plzTopTick pos _      (TickFunction fn q g)   =
+       plzTopTick pos _      (TickFunction fn q _)   =
                     qualifier pos q && pos `inside` fn
        plzTopTick pos label  (InsideFunction fn igs)   =
          pos `inside` fn && any (plzTopTick pos label) igs
@@ -95,11 +97,11 @@ processModule modName modContents (Mix filepath timestamp hash tabstop entries)
               ]
 
 
-   let show' (span,stuff) = show (span,stuff,grabHpcPos hsMap span)
+   -- let show' (srcspan,stuff) = show (srcspan,stuff,grabHpcPos hsMap span)
 
    let forest = createMixEntryDom
-              [ (span,ix)
-              | ((span,_),ix) <- zip entries [0..]
+              [ (srcspan,ix)
+              | ((srcspan,_),ix) <- zip entries [0..]
               ]
 
 
@@ -131,9 +133,9 @@ processModule modName modContents (Mix filepath timestamp hash tabstop entries)
    return $ TixModule modName hash (length tixs') tixs'
 
 qualifier :: HpcPos -> Maybe Qualifier -> Bool
-qualifier pos Nothing = True
+qualifier _   Nothing = True
 qualifier pos (Just (OnLine n)) = n == l1 && n == l2
-  where (l1,c1,l2,c2) = fromHpcPos pos
+  where (l1,_,l2,_) = fromHpcPos pos
 qualifier pos (Just (AtPosition l1' c1' l2' c2')) 
          = (l1', c1', l2', c2') == fromHpcPos pos
 
index 98e4181..f44f967 100644 (file)
@@ -5,9 +5,7 @@
 
 module HpcReport (report_plugin) where
 
-import System.Exit
 import Prelude hiding (exp)
-import System(getArgs)
 import List(sort,intersperse,sortBy)
 import HpcFlags
 import Trace.Hpc.Mix
@@ -104,8 +102,8 @@ allBinCounts mi =
 
 accumCounts :: [(BoxLabel,Integer)] -> ModInfo -> ModInfo
 accumCounts [] mi = mi
-accumCounts ((bl,btc):etc) mi | single bl =
-  accumCounts etc mi'
+accumCounts ((bl,btc):etc) mi
| single bl = accumCounts etc mi'
   where
   mi' = case bl of
         ExpBox False ->   mi{exp = inc (exp mi)}
@@ -120,6 +118,7 @@ accumCounts ((bl,btc):etc) mi | single bl =
        , tixCount = tc + bit (btc>0) }
   upd dp dps =
     if btc>0 then dps else dp:dps
+accumCounts [_] _ = error "accumCounts: Unhandled case: [_] _"
 accumCounts ((bl0,btc0):(bl1,btc1):etc) mi =
   accumCounts etc mi'
   where
@@ -159,7 +158,7 @@ modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do
          else mi
 
 modReport :: Flags -> TixModule -> IO ()
-modReport hpcflags tix@(TixModule moduleName _ _ tickCounts) = do
+modReport hpcflags tix@(TixModule moduleName _ _ _) = do
   mi <- modInfo hpcflags False tix
   if xmlOutput hpcflags 
     then putStrLn $ "  <module name = " ++ show moduleName  ++ ">"
@@ -201,6 +200,7 @@ modDecList hpcflags mi0 =
   showDecPath dp = putStrLn ("     "++
                              concat (intersperse "." dp))
 
+report_plugin :: Plugin
 report_plugin = Plugin { name = "report"
                       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]" 
                       , options = report_options 
@@ -222,12 +222,12 @@ report_main hpcflags (progName:mods) = do
     Just (Tix tickCounts) ->
           makeReport hpcflags1 progName 
                    $ sortBy (\ mod1 mod2 -> tixModuleName mod1 `compare` tixModuleName mod2)
-                   $ [ tix
-                     | tix@(TixModule m _h _ tcs) <- tickCounts
+                   $ [ tix'
+                     | tix'@(TixModule m _ _ _) <- tickCounts
                      , allowModule hpcflags1 m 
                      ]
     Nothing -> hpcError report_plugin  $ "unable to find tix file for:" ++ progName
-report_main hpcflags [] = 
+report_main _ [] = 
         hpcError report_plugin $ "no .tix file or executable name specified" 
 
 makeReport :: Flags -> String -> [TixModule] -> IO ()
@@ -256,12 +256,15 @@ element tag attrs = putStrLn $
                                   | (x,y) <- attrs
                                   ] ++ "/>"
 
+xmlBT :: BoxTixCounts -> [(String, String)]
 xmlBT (BT b t) = [("boxes",show b),("count",show t)]
 
+xmlBBT :: BinBoxTixCounts -> [(String, String)]
 xmlBBT (BBT b tt tf bt) = [("boxes",show b),("true",show tt),("false",show tf),("count",show (tt + tf + bt))]
 
 ------------------------------------------------------------------------------
 
+report_options :: FlagOptSeq
 report_options 
         = perModuleOpt
         . decListOpt
index 0d17668..efeb19e 100644 (file)
@@ -2,12 +2,12 @@ module HpcShowTix (showtix_plugin) where
 
 import Trace.Hpc.Mix
 import Trace.Hpc.Tix
-import Trace.Hpc.Util
 
 import HpcFlags
 
 import qualified HpcSet as Set
 
+showtix_options :: FlagOptSeq
 showtix_options 
         = excludeOpt
         . includeOpt
@@ -15,6 +15,7 @@ showtix_options
         . hpcDirOpt
         . outputOpt
 
+showtix_plugin :: Plugin
 showtix_plugin = Plugin { name = "show"
                       , usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]" 
                       , options = showtix_options 
@@ -25,8 +26,8 @@ showtix_plugin = Plugin { name = "show"
                       }
 
 
-
-showtix_main flags [] = hpcError showtix_plugin $ "no .tix file or executable name specified" 
+showtix_main :: Flags -> [String] -> IO ()
+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
@@ -50,10 +51,10 @@ showtix_main flags (prog:modNames) = do
        sequence_ [ sequence_ [ putStrLn (rjust 5 (show ix) ++ " " ++
                                          rjust 10 (show count) ++ " " ++
                                          ljust 20  modName ++ " " ++ rjust 20 (show pos) ++ " " ++ show lab)
-                             | (count,ix,(pos,lab)) <- zip3 tixs [(0::Int)..] entries
+                             | (count,ix,(pos,lab)) <- zip3 tixs' [(0::Int)..] entries
                              ]
-                 | ( TixModule modName hash _ tixs
-                   , Mix _file _timestamp _hash _tab entries
+                 | ( TixModule modName _hash1 _ tixs'
+                   , Mix _file _timestamp _hash2 _tab entries
                    ) <- tixs_mixs
                  ]
        
index ed8be63..0f56629 100644 (file)
@@ -2,18 +2,17 @@ module HpcUtils where
 
 import Trace.Hpc.Util
 import qualified HpcMap as Map
-import HpcFlags
 
 -- turns \n into ' '
 -- | grab's the text behind a HpcPos; 
 grabHpcPos :: Map.Map Int String -> HpcPos -> String
-grabHpcPos hsMap span = 
+grabHpcPos hsMap srcspan = 
          case lns of
            [ln] -> (take ((c2 - c1) + 1) $ drop (c1 - 1) ln)
            _ -> let lns1 = drop (c1 -1) (head lns) : tail lns
                     lns2 = init lns1 ++ [take (c2 + 1) (last lns1) ]
                  in foldl1 (\ xs ys -> xs ++ "\n" ++ ys) lns2
-  where (l1,c1,l2,c2) = fromHpcPos span
+  where (l1,c1,l2,c2) = fromHpcPos srcspan
         lns = map (\ n -> case Map.lookup n hsMap of
                            Just ln -> ln
                            Nothing -> error $ "bad line number : " ++ show n
@@ -21,7 +20,7 @@ grabHpcPos hsMap span =
 
 
 readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
-readFileFromPath err filename@('/':_) _ = readFile filename
+readFileFromPath _ filename@('/':_) _ = readFile filename
 readFileFromPath err filename path0 = readTheFile path0
   where
        readTheFile [] = err $ "could not find " ++ show filename 
index f36fd23..2c3d245 100644 (file)
@@ -39,11 +39,11 @@ parseArgs :: [String]
               Bool,      -- enable shell wrappers?
               Bool)      -- strip exe?
 parseArgs = f normal defaultDistPref False True
-    where f v dp esw strip (('-':'v':val):args)
+    where f _ dp esw strip (('-':'v':val):args)
               = f (readEOrFail flagToVerbosity val) dp esw strip args
           f v _  esw strip ("--distpref":dp:args) = f v dp esw strip args
           f v dp _   strip ("--enable-shell-wrappers":args) = f v dp True strip args
-          f v dp esw strip ("--disable-executable-stripping":args) = f v dp esw False args
+          f v dp esw _     ("--disable-executable-stripping":args) = f v dp esw False args
           f v dp esw strip [] = (v, dp, esw, strip)
           f _ _  _   _     args = error ("Bad arguments: " ++ show args)