Skip to content
Snippets Groups Projects
Unverified Commit f98f101a authored by Alec Theriault's avatar Alec Theriault Committed by GitHub
Browse files

Set UTF-8 encoding before writing files (#934)

This should fix #929, as well as guard against future problems of this
sort in other places. Basically replaces 'writeFile' (which selects the
users default locale) with 'writeUtf8File' (which always uses utf8).
parent a631fb6c
No related branches found
No related tags found
No related merge requests found
......@@ -36,7 +36,6 @@ import Data.Version
import System.Directory
import System.FilePath
import System.IO
prefix :: [String]
prefix = ["-- Hoogle documentation, generated by Haddock"
......@@ -56,10 +55,7 @@ ppHoogle dflags package version synopsis prologue ifaces odir = do
| not (null (versionBranch version)) ] ++
concat [ppModule dflags' i | i <- ifaces, OptHide `notElem` ifaceOptions i]
createDirectoryIfMissing True odir
h <- openFile (odir </> filename) WriteMode
hSetEncoding h utf8
hPutStr h (unlines contents)
hClose h
writeUtf8File (odir </> filename) (unlines contents)
ppModule :: DynFlags -> Interface -> [String]
ppModule dflags iface =
......
......@@ -6,6 +6,7 @@ module Haddock.Backends.Hyperlinker
import Haddock.Types
import Haddock.Utils (writeUtf8File)
import Haddock.Backends.Hyperlinker.Renderer
import Haddock.Backends.Hyperlinker.Types
import Haddock.Backends.Hyperlinker.Utils
......@@ -44,7 +45,7 @@ ppHyperlinkedModuleSource :: FilePath -> Bool -> SrcMap -> Interface
-> IO ()
ppHyperlinkedModuleSource srcdir pretty srcs iface =
case ifaceTokenizedSrc iface of
Just tokens -> writeFile path . html . render' $ tokens
Just tokens -> writeUtf8File path . html . render' $ tokens
Nothing -> return ()
where
render' = render (Just srcCssFile) (Just highlightScript) srcs
......
......@@ -135,7 +135,7 @@ ppLaTeXTop doctitle packageStr odir prologue maybe_style ifaces = do
filename = odir </> (fromMaybe "haddock" packageStr <.> "tex")
writeFile filename (show tex)
writeUtf8File filename (show tex)
ppLaTeXModule :: String -> FilePath -> Interface -> IO ()
......@@ -168,7 +168,7 @@ ppLaTeXModule _title odir iface = do
body = processExports exports
--
writeFile (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex)
writeUtf8File (odir </> moduleLaTeXFile mdl) (fullRender PageMode 80 1 txtPrinter "" tex)
-- | Prints out an entry in a module export list.
exportListItem :: ExportItem DocNameI -> LaTeX
......
......@@ -283,7 +283,7 @@ ppHtmlContents dflags odir doctitle _maybe_package
ppModuleTree pkg qual tree
]
createDirectoryIfMissing True odir
writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
writeUtf8File (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
ppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
......@@ -425,9 +425,9 @@ ppHtmlIndex odir doctitle _maybe_package themes
mapM_ (do_sub_index index) initialChars
-- Let's add a single large index as well for those who don't know exactly what they're looking for:
let mergedhtml = indexPage False Nothing index
writeFile (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString debug mergedhtml)
writeUtf8File (joinPath [odir, subIndexHtmlFile merged_name]) (renderToString debug mergedhtml)
writeFile (joinPath [odir, indexHtmlFile]) (renderToString debug html)
writeUtf8File (joinPath [odir, indexHtmlFile]) (renderToString debug html)
where
indexPage showLetters ch items =
......@@ -468,7 +468,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
do_sub_index this_ix c
= unless (null index_part) $
writeFile (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html)
writeUtf8File (joinPath [odir, subIndexHtmlFile [c]]) (renderToString debug html)
where
html = indexPage True (Just c) index_part
index_part = [(n,stuff) | (n,stuff) <- this_ix, toUpper (head n) == c]
......@@ -562,7 +562,7 @@ ppHtmlModule odir doctitle themes
]
createDirectoryIfMissing True odir
writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
writeUtf8File (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
signatureDocURL :: String
signatureDocURL = "https://wiki.haskell.org/Module_signature"
......
......@@ -33,6 +33,7 @@ module Haddock.Utils (
-- * Miscellaneous utilities
getProgramName, bye, die, dieMsg, noDieMsg, mapSnd, mapMaybeM, escapeStr,
writeUtf8File,
-- * HTML cross reference mapping
html_xrefs_ref, html_xrefs_ref',
......@@ -75,7 +76,7 @@ import Data.List ( isSuffixOf )
import Data.Maybe ( mapMaybe )
import System.Environment ( getProgName )
import System.Exit
import System.IO ( hPutStr, stderr )
import System.IO ( hPutStr, hSetEncoding, IOMode(..), stderr, utf8, withFile )
import System.IO.Unsafe ( unsafePerformIO )
import qualified System.FilePath.Posix as HtmlPath
import Distribution.Verbosity
......@@ -395,6 +396,15 @@ isAlphaChar c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')
isDigitChar c = c >= '0' && c <= '9'
isAlphaNumChar c = isAlphaChar c || isDigitChar c
-- | Utility to write output to UTF-8 encoded files.
--
-- The problem with 'writeFile' is that it picks up its 'TextEncoding' from
-- 'getLocaleEncoding', and on some platforms (like Windows) this default
-- encoding isn't enough for the characters we want to write.
writeUtf8File :: FilePath -> String -> IO ()
writeUtf8File filepath contents = withFile filepath WriteMode $ \h -> do
hSetEncoding h utf8
hPutStr h contents
-----------------------------------------------------------------------------
-- * HTML cross references
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment