diff --git a/Trace/Hpc/Tix.hs b/Trace/Hpc/Tix.hs index fa95dbfb76aebded03bdf5a0d93dcb715c0d5a71..4418781b139101a4810096209791953d74a22c6e 100644 --- a/Trace/Hpc/Tix.hs +++ b/Trace/Hpc/Tix.hs @@ -18,7 +18,7 @@ module Trace.Hpc.Tix(Tix(..), TixModule(..), import System.FilePath (replaceExtension) -import Trace.Hpc.Util (Hash, catchIO) +import Trace.Hpc.Util (Hash, catchIO, readFileUtf8, writeFileUtf8) -- | 'Tix' is the storage format for our dynamic information about -- what boxes are ticked. @@ -45,17 +45,15 @@ tixModuleTixs (TixModule _ _ _ tixs) = tixs -- | Read a @.tix@ File. readTix :: String -> IO (Maybe Tix) -readTix tix_filename = - catchIO (do contents <- readFile $ tix_filename - return $ Just $ read contents) - (\ _ -> return $ Nothing) +readTix tixFilename = + catchIO (fmap (Just . read) $ readFileUtf8 tixFilename) + (const $ return Nothing) -- | Write a @.tix@ File. writeTix :: String -> Tix -> IO () -writeTix name tix = - writeFile name (show tix) +writeTix name tix = writeFileUtf8 name (show tix) -- | 'getTixFullName' takes a binary or @.tix@-file name, -- and normalizes it into a @.tix@-file name. diff --git a/Trace/Hpc/Util.hs b/Trace/Hpc/Util.hs index 0e89c1fb89d68c6d8b1fdfc31c0991bfa7615608..135a2b73cf11936a5a0f0405e63e9e4c1a360360 100644 --- a/Trace/Hpc/Util.hs +++ b/Trace/Hpc/Util.hs @@ -16,13 +16,19 @@ module Trace.Hpc.Util , HpcHash(..) , Hash , catchIO + , readFileUtf8 + , writeFileUtf8 ) where +import Control.DeepSeq (deepseq) import qualified Control.Exception as Exception import Data.List(foldl') import Data.Char (ord) import Data.Bits (xor) import Data.Word +import System.Directory (createDirectoryIfMissing) +import System.FilePath (takeDirectory) +import System.IO -- | 'HpcPos' is an Hpc local rendition of a Span. data HpcPos = P !Int !Int !Int !Int deriving (Eq, Ord) @@ -117,3 +123,23 @@ hxor (Hash x) (Hash y) = Hash $ x `xor` y catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a catchIO = Exception.catch + + +-- | Read a file strictly, as opposed to how `readFile` does it using lazy IO, but also +-- disregard system locale and assume that the file is encoded in UTF-8. Haskell source +-- files are expected to be encoded in UTF-8 by GHC. +readFileUtf8 :: FilePath -> IO String +readFileUtf8 filepath = + withBinaryFile filepath ReadMode $ \h -> do + hSetEncoding h utf8 -- see #17073 + contents <- hGetContents h + contents `deepseq` hClose h -- prevent lazy IO + return contents + +-- | Write file in UTF-8 encoding. Parent directory will be created if missing. +writeFileUtf8 :: FilePath -> String -> IO () +writeFileUtf8 filepath str = do + createDirectoryIfMissing True (takeDirectory filepath) + withBinaryFile filepath WriteMode $ \h -> do + hSetEncoding h utf8 -- see #17073 + hPutStr h str diff --git a/changelog.md b/changelog.md index cb96ecbaa67d44db7d7d3dd2c61d26f37bd970e6..c8de8d064a1cf4e31c5fd59bae886d3fed966a24 100644 --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,10 @@ # Changelog for [`hpc` package](http://hackage.haskell.org/package/hpc) +## 0.6.1.0 *October 2019* + + * Addition of `readFielUtf8` and `writeFileUtf8` functions. + * Ensure `.tix` files read and written in UTF-8, regadless of the system locale. + ## 0.6.0.3 *May 2016* * Bundled with GHC 8.0.1 diff --git a/hpc.cabal b/hpc.cabal index 8f276a2eb591ad7be6ae0a095f8758cb71e4b0f6..63bdf3e6fdc987f40fc06be29e9416af9d46c4c6 100644 --- a/hpc.cabal +++ b/hpc.cabal @@ -1,5 +1,5 @@ name: hpc -version: 0.6.0.3 +version: 0.6.1.0 -- NOTE: Don't forget to update ./changelog.md license: BSD3 license-file: LICENSE @@ -37,6 +37,7 @@ Library Build-Depends: base >= 4.4.1 && < 4.15, containers >= 0.4.1 && < 0.7, + deepseq >= 1.1 && < 1.5, directory >= 1.1 && < 1.4, filepath >= 1 && < 1.5, time >= 1.2 && < 1.10 diff --git a/tests/simple/tixs/hpc_version.stdout b/tests/simple/tixs/hpc_version.stdout deleted file mode 100644 index e8d39b17c9c37165e46b0bce96da552b87751fd5..0000000000000000000000000000000000000000 --- a/tests/simple/tixs/hpc_version.stdout +++ /dev/null @@ -1 +0,0 @@ -hpc tools, version 0.67 diff --git a/tests/simple/tixs/test.T b/tests/simple/tixs/test.T index 753b9384cd2e6b1c1d152acb636482a856b9f1da..09630bd24b6e1e61da1e95e49e796cb3f79cb84f 100644 --- a/tests/simple/tixs/test.T +++ b/tests/simple/tixs/test.T @@ -35,7 +35,6 @@ test('hpc_show_error_002', exit_code(1), run_command, ["{hpc} show hpc001.hs"]) # bad .tix file test('hpc_help_version', normal, run_command, ["{hpc} help version"]) -test('hpc_version', normal, run_command, ["{hpc} version"]) test('hpc_help_draft', normal, run_command, ["{hpc} help draft"]) test('hpc_draft', extra_files(['.hpc/', 'hpc001.hs', 'hpc_sample.tix']), run_command, ["{hpc} draft hpc_sample.tix"])