X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fhpc%2FHpcMarkup.hs;fp=utils%2Fhpc%2FHpcMarkup.hs;h=e618b25ba8989acc6998e6b172c72f5396478f1e;hb=2fa48f4ea462a6e7f0bb22a8c292ee4efcec81e0;hp=f78a4af220cc1d4afdb601117e4e68e9bea8571d;hpb=f3052008e4fcd72681b12dfef551d0499eddf6a7;p=ghc-hetmet.git

diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs
index f78a4af..e618b25 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
