Split xml report from textual report

src/HpcReport.hs

@@ -7,7 +7,7 @@ module HpcReport (reportPlugin) where
 
 import Control.Monad hiding (guard)
 import Data.Function
-import Data.List (sort, sortBy, intercalate)
+import Data.List (intercalate, sort, sortBy)
 import qualified Data.Set as Set
 import HpcFlags
 import Trace.Hpc.Mix
@@ -31,27 +31,6 @@ instance Semigroup BoxTixCounts where
 instance Monoid BoxTixCounts where
   mempty = BT {boxCount = 0, tixCount = 0}
 
-btPercentage :: String -> BoxTixCounts -> String
-btPercentage s (BT b t) = showPercentage s t b
-
-showPercentage :: String -> Int -> Int -> String
-showPercentage s 0 0 = "100% " ++ s ++ " (0/0)"
-showPercentage s n d =
-  showWidth 3 p
-    ++ "% "
-    ++ s
-    ++ " ("
-    ++ show n
-    ++ "/"
-    ++ show d
-    ++ ")"
-  where
-    p = (n * 100) `div` d
-    showWidth w x0 = replicate (shortOf w (length sx)) ' ' ++ sx
-      where
-        sx = show x0
-        shortOf x y = if y < x then x - y else 0
-
 data BinBoxTixCounts = BBT
   { binBoxCount :: !Int,
     onlyTrueTixCount :: !Int,
@@ -77,21 +56,6 @@ instance Monoid BinBoxTixCounts where
         bothTixCount = 0
       }
 
-bbtPercentage :: String -> Bool -> BinBoxTixCounts -> String
-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"
-      else ""
-  where
-    detailFor n txt =
-      if n > 0
-        then ", " ++ show n ++ " " ++ txt
-        else ""
-
 data ModInfo = MI
   { exp, alt, top, loc :: !BoxTixCounts,
     guard, cond, qual :: !BinBoxTixCounts,
@@ -198,28 +162,27 @@ single (TopLevelBox _) = True
 single (LocalBox _) = True
 single (BinBox {}) = False
 
-modInfo :: Flags -> Bool -> TixModule -> IO ModInfo
-modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do
-  Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix)
-  return (q (accumCounts (zip (map snd mes) tickCounts) mempty))
-  where
-    q mi =
-      if qualDecList
-        then mi {decPaths = map (moduleName :) (decPaths mi)}
-        else mi
+------------------------------------------------------------------------------
+-- XML Report
 
-modReport :: Flags -> TixModule -> IO ()
-modReport hpcflags tix@(TixModule moduleName _ _ _) = do
-  mi <- modInfo hpcflags False tix
-  if xmlOutput hpcflags
-    then putStrLn $ "  <module name = " ++ show moduleName ++ ">"
-    else putStrLn ("-----<module " ++ moduleName ++ ">-----")
-  printModInfo hpcflags mi
-  when (xmlOutput hpcflags) $ do
-    putStrLn "  </module>"
-
-printModInfo :: Flags -> ModInfo -> IO ()
-printModInfo hpcflags mi | xmlOutput hpcflags = do
+makeXmlReport :: Flags -> String -> [TixModule] -> IO ()
+makeXmlReport hpcflags progName modTcs = do
+  putStrLn "<?xml version=\"1.0\" encoding=\"UTF-8\"?>"
+  putStrLn $ "<coverage name=" ++ show progName ++ ">"
+  when (perModule hpcflags) $ do
+    forM_ modTcs $ \tix@(TixModule moduleName _ _ _) -> do
+      mi <- modInfo hpcflags False tix
+      putStrLn $ "  <module name = " ++ show moduleName ++ ">"
+      printXmlModInfo mi
+      putStrLn "  </module>"
+  mis <- mapM (modInfo hpcflags True) modTcs
+  putStrLn "  <summary>"
+  printXmlModInfo (mconcat mis)
+  putStrLn "  </summary>"
+  putStrLn "</coverage>"
+
+printXmlModInfo :: ModInfo -> IO ()
+printXmlModInfo mi = do
   element "exprs" (xmlBT $ exp mi)
   element "booleans" (xmlBBT $ allBinCounts mi)
   element "guards" (xmlBBT $ guard mi)
@@ -228,7 +191,49 @@ printModInfo hpcflags mi | xmlOutput hpcflags = do
   element "alts" (xmlBT $ alt mi)
   element "local" (xmlBT $ loc mi)
   element "toplevel" (xmlBT $ top mi)
-printModInfo hpcflags mi = do
+
+element :: String -> [(String, String)] -> IO ()
+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)
+  ]
+
+xmlBBT :: BinBoxTixCounts -> [(String, String)]
+xmlBBT (BBT b tt tf bt) =
+  [ ("boxes", show b),
+    ("true", show tt),
+    ("false", show tf),
+    ("count", show (tt + tf + bt))
+  ]
+
+------------------------------------------------------------------------------
+-- Textual Report
+
+makeTxtReport :: Flags -> String -> [TixModule] -> IO ()
+makeTxtReport hpcflags _ modTcs =
+  if perModule hpcflags
+    then forM_ modTcs $ \tix@(TixModule moduleName _ _ _) -> do
+      mi <- modInfo hpcflags False tix
+      putStrLn ("-----<module " ++ moduleName ++ ">-----")
+      printTxtModInfo hpcflags mi
+    else do
+      mis <- mapM (modInfo hpcflags True) modTcs
+      printTxtModInfo hpcflags (mconcat mis)
+
+printTxtModInfo :: Flags -> ModInfo -> IO ()
+printTxtModInfo hpcflags mi = do
   putStrLn (btPercentage "expressions used" (exp mi))
   putStrLn (bbtPercentage "boolean coverage" False (allBinCounts mi))
   putStrLn ("     " ++ bbtPercentage "guards" True (guard mi))
@@ -237,20 +242,65 @@ printModInfo hpcflags mi = do
   putStrLn (btPercentage "alternatives used" (alt mi))
   putStrLn (btPercentage "local declarations used" (loc mi))
   putStrLn (btPercentage "top-level declarations used" (top mi))
-  modDecList hpcflags mi
-
-modDecList :: Flags -> ModInfo -> IO ()
-modDecList hpcflags mi0 =
-  when (decList hpcflags && someDecsUnused mi0) $ do
+  when (decList hpcflags && someDecsUnused) $ do
     putStrLn "unused declarations:"
-    mapM_ showDecPath (sort (decPaths mi0))
+    mapM_ showDecPath (sort (decPaths mi))
   where
-    someDecsUnused mi =
+    someDecsUnused =
       tixCount (top mi) < boxCount (top mi)
         || tixCount (loc mi) < boxCount (loc mi)
     showDecPath dp =
       putStrLn ("     " ++ intercalate "." dp)
 
+btPercentage :: String -> BoxTixCounts -> String
+btPercentage s (BT b t) = showPercentage s t b
+
+bbtPercentage :: String -> Bool -> BinBoxTixCounts -> String
+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"
+      else ""
+  where
+    detailFor n txt =
+      if n > 0
+        then ", " ++ show n ++ " " ++ txt
+        else ""
+
+showPercentage :: String -> Int -> Int -> String
+showPercentage s 0 0 = "100% " ++ s ++ " (0/0)"
+showPercentage s n d =
+  showWidth 3 p
+    ++ "% "
+    ++ s
+    ++ " ("
+    ++ show n
+    ++ "/"
+    ++ show d
+    ++ ")"
+  where
+    p = (n * 100) `div` d
+    showWidth w x0 = replicate (shortOf w (length sx)) ' ' ++ sx
+      where
+        sx = show x0
+        shortOf x y = if y < x then x - y else 0
+
+------------------------------------------------------------------------------
+-- Plugin
+
+modInfo :: Flags -> Bool -> TixModule -> IO ModInfo
+modInfo hpcflags qualDecList tix@(TixModule moduleName _ _ tickCounts) = do
+  Mix _ _ _ _ mes <- readMixWithFlags hpcflags (Right tix)
+  return (q (accumCounts (zip (map snd mes) tickCounts) mempty))
+  where
+    q mi =
+      if qualDecList
+        then mi {decPaths = map (moduleName :) (decPaths mi)}
+        else mi
+
 reportPlugin :: Plugin
 reportPlugin =
   Plugin
@@ -269,60 +319,17 @@ reportMain hpcflags (progName : mods) = do
   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]
+    Just (Tix tickCounts) -> do
+      let sortFun mod1 mod2 = tixModuleName mod1 `compare` tixModuleName mod2
+      let allowedModules = [tix' | tix'@(TixModule m _ _ _) <- tickCounts, allowModule hpcflags1 m]
+      let sortedModules = sortBy sortFun allowedModules
+      if xmlOutput hpcflags1
+        then makeXmlReport hpcflags1 progName sortedModules
+        else makeTxtReport hpcflags1 progName sortedModules
     Nothing -> hpcError reportPlugin $ "unable to find tix file for:" ++ progName
 reportMain _ [] =
   hpcError reportPlugin "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 ++ ">"
-  when (perModule hpcflags) $ do
-    mapM_ (modReport hpcflags) modTcs
-  mis <- mapM (modInfo hpcflags True) modTcs
-  putStrLn "  <summary>"
-  printModInfo hpcflags (mconcat mis)
-  putStrLn "  </summary>"
-  putStrLn "</coverage>"
-makeReport hpcflags _ modTcs =
-  if perModule hpcflags
-    then mapM_ (modReport hpcflags) modTcs
-    else do
-      mis <- mapM (modInfo hpcflags True) modTcs
-      printModInfo hpcflags (mconcat mis)
-
-element :: String -> [(String, String)] -> IO ()
-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)
-  ]
-
-xmlBBT :: BinBoxTixCounts -> [(String, String)]
-xmlBBT (BBT b tt tf bt) =
-  [ ("boxes", show b),
-    ("true", show tt),
-    ("false", show tf),
-    ("count", show (tt + tf + bt))
-  ]
-
-------------------------------------------------------------------------------
-
 reportFlags :: FlagOptSeq
 reportFlags =
   perModuleOpt