diff options
| author | andygill@ku.edu <unknown> | 2008-09-15 20:43:22 +0000 |
|---|---|---|
| committer | andygill@ku.edu <unknown> | 2008-09-15 20:43:22 +0000 |
| commit | 2fa48f4ea462a6e7f0bb22a8c292ee4efcec81e0 (patch) | |
| tree | 133784f4868409c6327372774f752369884ef685 /utils | |
| parent | f3052008e4fcd72681b12dfef551d0499eddf6a7 (diff) | |
| download | haskell-2fa48f4ea462a6e7f0bb22a8c292ee4efcec81e0.tar.gz | |
Fix Trac #2311: creates subdirs for package coverage information
Diffstat (limited to 'utils')
| -rw-r--r-- | utils/hpc/HpcMarkup.hs | 30 |
1 files changed, 20 insertions, 10 deletions
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index f78a4af220..e618b25ba8 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -60,11 +60,6 @@ markup_main flags (prog:modNames) = do 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 hpcflags1 tix theFunTotals invertOutput | tix <- tixs @@ -79,11 +74,9 @@ markup_main flags (prog:modNames) = do let writeSummary filename cmp = do let mods' = sortBy cmp mods - - - putStrLn $ "Writing: " ++ (filename ++ ".html") - writeFile (dest_dir ++ "/" ++ filename ++ ".html") $ + + writeFileUsing (dest_dir ++ "/" ++ filename ++ ".html") $ "<html>" ++ "<style type=\"text/css\">" ++ "table.bar { background-color: #f25913; }\n" ++ @@ -211,7 +204,7 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do let addLines = unlines . map (uncurry addLine) . zip [1 :: Int ..] . lines let fileName = modName0 ++ ".hs.html" putStrLn $ "Writing: " ++ fileName - writeFile (dest_dir ++ "/" ++ fileName) $ + writeFileUsing (dest_dir ++ "/" ++ fileName) $ unlines [ "<html><style type=\"text/css\">", "span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }", if invertOutput @@ -449,6 +442,23 @@ instance Monoid ModuleSummary where ------------------------------------------------------------------------------ + +writeFileUsing :: String -> String -> IO () +writeFileUsing filename text = do + let dest_dir = reverse . dropWhile (\ x -> x /= '/') . reverse $ filename + +-- We need to check for the dest_dir each time, because we use sub-dirs for +-- packages, and a single .tix file might contain information about +-- many package. + +#if __GLASGOW_HASKELL__ >= 604 + -- create the dest_dir if needed + createDirectoryIfMissing True dest_dir +#endif + + writeFile filename text + +------------------------------------------------------------------------------ -- global color pallete red,green,yellow :: String |