diff options
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hoogle.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 3 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml.hs | 10 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Utils.hs | 12 |
5 files changed, 21 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs index 885c608b..eb93ade2 100644 --- a/haddock-api/src/Haddock/Backends/Hoogle.hs +++ b/haddock-api/src/Haddock/Backends/Hoogle.hs @@ -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 = diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 248a8a54..8f0c4b67 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -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 diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 0c7747bd..d2baf69a 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -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 diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs index 6da6a2e8..f5fc4c3e 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml.hs @@ -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" diff --git a/haddock-api/src/Haddock/Utils.hs b/haddock-api/src/Haddock/Utils.hs index c2cdddf7..0ce99fb2 100644 --- a/haddock-api/src/Haddock/Utils.hs +++ b/haddock-api/src/Haddock/Utils.hs @@ -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 |