diff options
| author | Alexey Kuleshevich <alexey@kuleshevi.ch> | 2019-08-18 03:38:37 -0400 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-11-19 20:39:20 -0500 |
| commit | ef8a08e0dd4e5b908b7fbce1b3101dc311c4d3e1 (patch) | |
| tree | a30180b45f705c3006fb4628b2e6284aab49f065 /utils/hpc | |
| parent | d1f3c63701b7f0fd675f792af7f33c5b11eaff83 (diff) | |
| download | haskell-ef8a08e0dd4e5b908b7fbce1b3101dc311c4d3e1.tar.gz | |
hpc: Fix encoding issues. Add test for and fix #17073
* Make sure files are being read/written in UTF-8. Set encoding while writing
HTML output. Also set encoding while writing and reading .tix files although
we don't yet have a ticket complaining that this poses problems.
* Set encoding in html header to utf8
* Upgrade to new version of 'hpc' library and reuse `readFileUtf8`
and `writeFileUtf8` functions
* Update git submodule for `hpc`
* Bump up `hpc` executable version
Co-authored-by: Ben Gamari <ben@smart-cactus.org>
Diffstat (limited to 'utils/hpc')
| -rw-r--r-- | utils/hpc/HpcMarkup.hs | 30 | ||||
| -rw-r--r-- | utils/hpc/HpcUtils.hs | 7 | ||||
| -rw-r--r-- | utils/hpc/hpc-bin.cabal | 7 |
3 files changed, 11 insertions, 33 deletions
diff --git a/utils/hpc/HpcMarkup.hs b/utils/hpc/HpcMarkup.hs index a9b5ce1722..70519600e9 100644 --- a/utils/hpc/HpcMarkup.hs +++ b/utils/hpc/HpcMarkup.hs @@ -7,14 +7,12 @@ module HpcMarkup (markup_plugin) where import Trace.Hpc.Mix import Trace.Hpc.Tix -import Trace.Hpc.Util +import Trace.Hpc.Util (HpcPos, fromHpcPos, writeFileUtf8) import HpcFlags import HpcUtils -import System.Directory import System.FilePath -import System.IO (localeEncoding) import Data.List import Data.Maybe(fromJust) import Data.Semigroup as Semi @@ -82,10 +80,10 @@ markup_main flags (prog:modNames) = do unless (verbosity flags < Normal) $ putStrLn $ "Writing: " ++ (filename <.> "html") - writeFileUsing (dest_dir </> filename <.> "html") $ + writeFileUtf8 (dest_dir </> filename <.> "html") $ "<html>" ++ "<head>" ++ - charEncodingTag ++ + "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">" ++ "<style type=\"text/css\">" ++ "table.bar { background-color: #f25913; }\n" ++ "td.bar { background-color: #60de51; }\n" ++ @@ -139,11 +137,6 @@ markup_main flags (prog:modNames) = do markup_main _ [] = hpcError markup_plugin $ "no .tix file or executable name specified" -charEncodingTag :: String -charEncodingTag = - "<meta http-equiv=\"Content-Type\" " ++ - "content=\"text/html; " ++ "charset=" ++ show localeEncoding ++ "\">" - -- Add characters to the left of a string until it is at least as -- large as requested. padLeft :: Int -> Char -> String -> String @@ -229,10 +222,10 @@ genHtmlFromMod dest_dir flags tix theFunTotals invertOutput = do let fileName = modName0 <.> "hs" <.> "html" unless (verbosity flags < Normal) $ putStrLn $ "Writing: " ++ fileName - writeFileUsing (dest_dir </> fileName) $ + writeFileUtf8 (dest_dir </> fileName) $ unlines ["<html>", "<head>", - charEncodingTag, + "<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">", "<style type=\"text/css\">", "span.lineno { color: white; background: #aaaaaa; border-right: solid white 12px }", if invertOutput @@ -484,19 +477,6 @@ instance Monoid ModuleSummary where mappend = (<>) ------------------------------------------------------------------------------ - -writeFileUsing :: String -> String -> IO () -writeFileUsing filename text = do --- 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. - - -- create the dest_dir if needed - createDirectoryIfMissing True (takeDirectory filename) - - writeFile filename text - ------------------------------------------------------------------------------- -- global color pallete red,green,yellow :: String diff --git a/utils/hpc/HpcUtils.hs b/utils/hpc/HpcUtils.hs index 6ee44b1ae6..da62f4a364 100644 --- a/utils/hpc/HpcUtils.hs +++ b/utils/hpc/HpcUtils.hs @@ -1,6 +1,6 @@ module HpcUtils where -import Trace.Hpc.Util +import Trace.Hpc.Util (catchIO, HpcPos, fromHpcPos, readFileUtf8) import qualified Data.Map as Map import System.FilePath @@ -25,12 +25,11 @@ grabHpcPos hsMap srcspan = readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String -readFileFromPath _ filename@('/':_) _ = readFile filename +readFileFromPath _ filename@('/':_) _ = readFileUtf8 filename readFileFromPath err filename path0 = readTheFile path0 where readTheFile [] = err $ "could not find " ++ show filename ++ " in path " ++ show path0 readTheFile (dir:dirs) = - catchIO (do str <- readFile (dir </> filename) - return str) + catchIO (readFileUtf8 (dir </> filename)) (\ _ -> readTheFile dirs) diff --git a/utils/hpc/hpc-bin.cabal b/utils/hpc/hpc-bin.cabal index a1368cf8d0..28cc2af49b 100644 --- a/utils/hpc/hpc-bin.cabal +++ b/utils/hpc/hpc-bin.cabal @@ -1,14 +1,13 @@ Name: hpc-bin -- XXX version number: -Version: 0.67 +Version: 0.68 Copyright: XXX License: BSD3 -- XXX License-File: LICENSE Author: XXX Maintainer: XXX Synopsis: XXX -Description: - XXX +Description: XXX Category: Development build-type: Simple cabal-version: >=1.10 @@ -33,5 +32,5 @@ Executable hpc filepath >= 1 && < 1.5, containers >= 0.1 && < 0.7, array >= 0.1 && < 0.6, - hpc + hpc >= 0.6.1 && < 0.7 |