aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/Hyperlinker.hs3
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs10
-rw-r--r--haddock-api/src/Haddock/Utils.hs12
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