import Trace.Hpc.Util
import HpcFlags
+import HpcUtils
import System.Environment
import System.Directory
import Data.List
import Data.Maybe(fromJust)
import Data.Array
-import qualified Data.Set as Set
+import Data.Monoid
+import qualified HpcSet as Set
------------------------------------------------------------------------------
-markup_options =
- [ excludeOpt,includeOpt,hpcDirOpt,hsDirOpt,funTotalsOpt
- , altHighlightOpt
- , destDirOpt
- ]
+markup_options
+ = excludeOpt
+ . includeOpt
+ . srcDirOpt
+ . hpcDirOpt
+ . funTotalsOpt
+ . altHighlightOpt
+ . destDirOpt
markup_plugin = Plugin { name = "markup"
, usage = "[OPTION] .. <TIX_FILE> [<MODULE> [<MODULE> ..]]"
`Set.union`
includeMods flags }
let Flags
- { hpcDirs = hpcDirs
- , hsDirs = theHsPath
- , funTotals = theFunTotals
+ { funTotals = theFunTotals
, altHighlight = invertOutput
, destDir = dest_dir
} = hpcflags1
mtix <- readTix (getTixFileName prog)
Tix tixs <- case mtix of
- Nothing -> error $ "unable to find tix file for: " ++ prog
+ Nothing -> hpcError markup_plugin $ "unable to find tix file for: " ++ prog
Just a -> return a
+#if __GLASGOW_HASKELL__ >= 604
-- create the dest_dir if needed
createDirectoryIfMissing True dest_dir
+#endif
mods <-
- sequence [ genHtmlFromMod dest_dir hpcDirs tix theFunTotals theHsPath invertOutput
+ sequence [ genHtmlFromMod dest_dir hpcflags1 tix theFunTotals invertOutput
| tix <- tixs
, allowModule hpcflags1 (tixModuleName tix)
]
| (modName,fileName,summary) <- mods'
] ++
"<tr></tr>" ++
- showTotalSummary (foldr1 combineSummary
+ showTotalSummary (mconcat
[ summary
| (_,_,summary) <- mods'
])
(percent (expTicked s1) (expTotal s1))
-markup_main flags [] = error $ "no .tix file or executable name specified"
+markup_main flags [] = hpcError markup_plugin $ "no .tix file or executable name specified"
genHtmlFromMod
:: String
- -> [FilePath]
+ -> Flags
-> TixModule
-> Bool
- -> [String]
-> Bool
-> IO (String, [Char], ModuleSummary)
-genHtmlFromMod dest_dir hpcDirs tix theFunTotals theHsPath invertOutput = do
+genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do
+ let theHsPath = srcDirs flags
let modName0 = tixModuleName tix
- (Mix origFile _ mixHash tabStop mix') <- readMix hpcDirs modName0
+ (Mix origFile _ mixHash tabStop mix') <- readMixWithFlags flags (Right tix)
let arr_tix :: Array Int Integer
arr_tix = listArray (0,length (tixModuleTixs tix) - 1)
, let ticked = if isTicked gid
then succ
else id
- ] $ ModuleSummary
- { expTicked = 0
- , expTotal = 0
- , topFunTicked = 0
- , topFunTotal = 0
- , altTicked = 0
- , altTotal = 0
- }
+ ] $ mempty
-- add prefix to modName argument
- content <- readFileFromPath origFile theHsPath
+ content <- readFileFromPath (hpcError markup_plugin) origFile theHsPath
let content' = markup tabStop info content
let show' = reverse . take 5 . (++ " ") . reverse . show
percent ticked total = if total == 0 then Nothing else Just (ticked * 100 `div` total)
-combineSummary :: ModuleSummary -> ModuleSummary -> ModuleSummary
-combineSummary (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1)
- (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2)
- = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2)
+instance Monoid ModuleSummary where
+ mempty = ModuleSummary
+ { expTicked = 0
+ , expTotal = 0
+ , topFunTicked = 0
+ , topFunTotal = 0
+ , altTicked = 0
+ , altTotal = 0
+ }
+ mappend (ModuleSummary eTik1 eTot1 tTik1 tTot1 aTik1 aTot1)
+ (ModuleSummary eTik2 eTot2 tTik2 tTot2 aTik2 aTot2)
+ = ModuleSummary (eTik1 + eTik2) (eTot1 + eTot2) (tTik1 + tTik2) (tTot1 + tTot2) (aTik1 + aTik2) (aTot1 + aTot2)
+
------------------------------------------------------------------------------
-- global color pallete
green = "#60de51"
yellow = "yellow"
-------------------------------------------------------------------------------
-
-readFileFromPath :: String -> [String] -> IO String
-readFileFromPath filename@('/':_) _ = readFile filename
-readFileFromPath filename path0 = readTheFile path0
- where
- readTheFile :: [String] -> IO String
- readTheFile [] = error $ "could not find " ++ show filename
- ++ " in path " ++ show path0
- readTheFile (dir:dirs) =
- catch (do str <- readFile (dir ++ "/" ++ filename)
- return str)
- (\ _ -> readTheFile dirs)