aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Haddock/Backends/DevHelp.hs3
-rw-r--r--src/Haddock/Backends/HH.hs8
-rw-r--r--src/Haddock/Backends/HH2.hs12
-rw-r--r--src/Haddock/Backends/Html.hs21
-rw-r--r--src/Haddock/Backends/Xhtml.hs21
-rw-r--r--src/Haddock/Utils.hs14
6 files changed, 36 insertions, 43 deletions
diff --git a/src/Haddock/Backends/DevHelp.hs b/src/Haddock/Backends/DevHelp.hs
index c42f494a..4028890d 100644
--- a/src/Haddock/Backends/DevHelp.hs
+++ b/src/Haddock/Backends/DevHelp.hs
@@ -20,6 +20,7 @@ import Name ( Name, nameModule, getOccString, nameOccName )
import Data.Maybe ( fromMaybe )
import qualified Data.Map as Map
+import System.FilePath
import Text.PrettyPrint
ppDevHelpFile :: FilePath -> String -> Maybe String -> [Interface] -> IO ()
@@ -37,7 +38,7 @@ ppDevHelpFile odir doctitle maybe_package ifaces = do
nest 4 (ppList index) $+$
text "</functions>" $$
text "</book>"
- writeFile (pathJoin [odir, devHelpFile]) (render doc)
+ writeFile (joinPath [odir, devHelpFile]) (render doc)
where
package = fromMaybe "pkg" maybe_package
diff --git a/src/Haddock/Backends/HH.hs b/src/Haddock/Backends/HH.hs
index ea14d41a..39390573 100644
--- a/src/Haddock/Backends/HH.hs
+++ b/src/Haddock/Backends/HH.hs
@@ -39,7 +39,7 @@ ppHHContents odir doctitle maybe_package tree = do
text "</HEAD><BODY>" $$
ppModuleTree tree $$
text "</BODY><HTML>"
- writeFile (pathJoin [odir, contentsHHFile]) (render html)
+ writeFile (joinPath [odir, contentsHHFile]) (render html)
where
package = fromMaybe "pkg" maybe_package
@@ -102,7 +102,7 @@ ppHHIndex odir maybe_package ifaces = do
nest 4 (ppList index) $+$
text "</UL>" $$
text "</BODY><HTML>"
- writeFile (pathJoin [odir, indexHHFile]) (render html)
+ writeFile (joinPath [odir, indexHHFile]) (render html)
where
package = fromMaybe "pkg" maybe_package
@@ -148,7 +148,7 @@ ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
text indexHtmlFile $$
ppIndexFiles chars $$
ppLibFiles ("":pkg_paths)
- writeFile (pathJoin [odir, projectHHFile]) (render doc)
+ writeFile (joinPath [odir, projectHHFile]) (render doc)
where
package = fromMaybe "pkg" maybe_package
@@ -173,7 +173,7 @@ ppHHProject odir doctitle maybe_package ifaces pkg_paths = do
ppLibFiles paths
where
toPath fname | null path = fname
- | otherwise = pathJoin [path, fname]
+ | otherwise = joinPath [path, fname]
ppLibFile fname = text (toPath fname)
chars :: [Char]
diff --git a/src/Haddock/Backends/HH2.hs b/src/Haddock/Backends/HH2.hs
index 406ad87e..7a49bded 100644
--- a/src/Haddock/Backends/HH2.hs
+++ b/src/Haddock/Backends/HH2.hs
@@ -43,7 +43,7 @@ ppHH2Contents odir doctitle maybe_package tree = do
nest 4 (ppModuleTree [] tree) $+$
text "</HelpTOCNode>") $$
text "</HelpTOC>"
- writeFile (pathJoin [odir, contentsHH2File]) (render doc)
+ writeFile (joinPath [odir, contentsHH2File]) (render doc)
where
package = fromMaybe "pkg" maybe_package
@@ -95,8 +95,8 @@ ppHH2Index odir maybe_package ifaces = do
nest 4 (text "<Jump Url=\""<>text contentsHtmlFile<>text "\"/>") $$
text "</Keyword>" $$
text "</HelpIndex>"
- writeFile (pathJoin [odir, indexKHH2File]) (render docK)
- writeFile (pathJoin [odir, indexNHH2File]) (render docN)
+ writeFile (joinPath [odir, indexKHH2File]) (render docK)
+ writeFile (joinPath [odir, indexNHH2File]) (render docN)
where
package = fromMaybe "pkg" maybe_package
@@ -132,7 +132,7 @@ ppHH2Files odir maybe_package ifaces pkg_paths = do
ppIndexFiles chars $$
ppLibFiles ("":pkg_paths)) $$
text "</HelpFileList>"
- writeFile (pathJoin [odir, filesHH2File]) (render doc)
+ writeFile (joinPath [odir, filesHH2File]) (render doc)
where
package = fromMaybe "pkg" maybe_package
@@ -157,7 +157,7 @@ ppHH2Files odir maybe_package ifaces pkg_paths = do
ppLibFiles paths
where
toPath fname | null path = fname
- | otherwise = pathJoin [path, fname]
+ | otherwise = joinPath [path, fname]
ppLibFile fname = text "<File Url=\""<>text (toPath fname)<>text "\"/>"
chars :: [Char]
@@ -192,5 +192,5 @@ ppHH2Collection odir doctitle maybe_package = do
text "<ItemMoniker Name=\"!DefaultNamedUrlIndex\" ProgId=\"HxDs.HxIndex\" InitData=\"NamedURLIndex\"/>" $$
text "<ItemMoniker Name=\"!SampleInfo\" ProgId=\"HxDs.HxSampleCollection\" InitData=\"\"/>") $$
text "</HelpCollection>"
- writeFile (pathJoin [odir, collectionHH2File]) (render doc)
+ writeFile (joinPath [odir, collectionHH2File]) (render doc)
-}
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 3a334475..09d9fc5e 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -37,6 +37,7 @@ import Data.Maybe
import Foreign.Marshal.Alloc ( allocaBytes )
import System.IO ( IOMode(..), hClose, hGetBuf, hPutBuf, openFile )
import System.Directory hiding ( copyFile )
+import System.FilePath hiding ( (</>) )
import Data.Map ( Map )
import qualified Data.Map as Map hiding ( Map )
import Data.Function
@@ -138,13 +139,13 @@ copyFile fromFPath toFPath =
copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO ()
copyHtmlBits odir libdir maybe_css = do
let
- libhtmldir = pathJoin [libdir, "html"]
+ libhtmldir = joinPath [libdir, "html"]
css_file = case maybe_css of
- Nothing -> pathJoin [libhtmldir, cssFile]
+ Nothing -> joinPath [libhtmldir, cssFile]
Just f -> f
- css_destination = pathJoin [odir, cssFile]
+ css_destination = joinPath [odir, cssFile]
copyLibFile f = do
- copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f])
+ copyFile (joinPath [libhtmldir, f]) (joinPath [odir, f])
copyFile css_file css_destination
mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile, framesFile ]
@@ -327,7 +328,7 @@ ppHtmlContents odir doctitle
footer
)
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, contentsHtmlFile]) (renderHtml html)
+ writeFile (joinPath [odir, contentsHtmlFile]) (renderHtml html)
-- XXX: think of a better place for this?
ppHtmlContentsFrame odir doctitle ifaces
@@ -445,7 +446,7 @@ ppHtmlContentsFrame odir doctitle ifaces = do
body << vanillaTable << Html.p << (
foldr (+++) noHtml (map (+++br) mods))
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, frameIndexHtmlFile]) (renderHtml html)
+ writeFile (joinPath [odir, frameIndexHtmlFile]) (renderHtml html)
-- ---------------------------------------------------------------------------
-- Generate the index
@@ -477,7 +478,7 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
when split_indices $
mapM_ (do_sub_index index) initialChars
- writeFile (pathJoin [odir, indexHtmlFile]) (renderHtml html)
+ writeFile (joinPath [odir, indexHtmlFile]) (renderHtml html)
-- Generate index and contents page for Html Help if requested
case maybe_html_help_format of
@@ -528,7 +529,7 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
do_sub_index this_ix c
= unless (null index_part) $
- writeFile (pathJoin [odir, subIndexHtmlFile c]) (renderHtml html)
+ writeFile (joinPath [odir, subIndexHtmlFile c]) (renderHtml html)
where
html = header (documentCharacterEncoding +++
thetitle (toHtml (doctitle ++ " (Index)")) +++
@@ -625,7 +626,7 @@ ppHtmlModule odir doctitle
footer
)
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, moduleHtmlFile mdl]) (renderHtml html)
+ writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderHtml html)
ppHtmlModuleMiniSynopsis odir doctitle iface unicode
ppHtmlModuleMiniSynopsis :: FilePath -> String -> Interface -> Bool -> IO ()
@@ -642,7 +643,7 @@ ppHtmlModuleMiniSynopsis odir _doctitle iface unicode = do
<< toHtml (moduleString mdl)) +++
miniSynopsis mdl iface unicode)
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, "mini_" ++ moduleHtmlFile mdl]) (renderHtml html)
+ writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderHtml html)
ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> HtmlTable
ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 461c7b40..dad65a4c 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -44,6 +44,7 @@ import Data.Either
import Data.List ( sortBy, groupBy )
import Data.Maybe
import Foreign.Marshal.Alloc ( allocaBytes )
+import System.FilePath hiding ( (</>) )
import System.IO ( IOMode(..), hClose, hGetBuf, hPutBuf, openFile )
import System.Directory hiding ( copyFile )
import Data.Map ( Map )
@@ -140,13 +141,13 @@ copyFile fromFPath toFPath =
copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO ()
copyHtmlBits odir libdir maybe_css = do
let
- libhtmldir = pathJoin [libdir, "html"]
+ libhtmldir = joinPath [libdir, "html"]
css_file = case maybe_css of
- Nothing -> pathJoin [libhtmldir, 'x':cssFile]
+ Nothing -> joinPath [libhtmldir, 'x':cssFile]
Just f -> f
- css_destination = pathJoin [odir, cssFile]
+ css_destination = joinPath [odir, cssFile]
copyLibFile f = do
- copyFile (pathJoin [libhtmldir, f]) (pathJoin [odir, f])
+ copyFile (joinPath [libhtmldir, f]) (joinPath [odir, f])
copyFile css_file css_destination
mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile, framesFile ]
@@ -276,7 +277,7 @@ ppHtmlContents odir doctitle
footer
)
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, contentsHtmlFile]) (renderToString html)
+ writeFile (joinPath [odir, contentsHtmlFile]) (renderToString html)
-- XXX: think of a better place for this?
ppHtmlContentsFrame odir doctitle ifaces
@@ -392,7 +393,7 @@ ppHtmlContentsFrame odir doctitle ifaces = do
body << vanillaTable << Html.p << (
foldr (+++) noHtml (map (+++br) mods))
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, frameIndexHtmlFile]) (renderToString html)
+ writeFile (joinPath [odir, frameIndexHtmlFile]) (renderToString html)
-- ---------------------------------------------------------------------------
-- Generate the index
@@ -424,7 +425,7 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
when split_indices $
mapM_ (do_sub_index index) initialChars
- writeFile (pathJoin [odir, indexHtmlFile]) (renderToString html)
+ writeFile (joinPath [odir, indexHtmlFile]) (renderToString html)
-- Generate index and contents page for Html Help if requested
case maybe_html_help_format of
@@ -480,7 +481,7 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format
do_sub_index this_ix c
= unless (null index_part) $
- writeFile (pathJoin [odir, subIndexHtmlFile c]) (renderToString html)
+ writeFile (joinPath [odir, subIndexHtmlFile c]) (renderToString html)
where
html = header (documentCharacterEncoding +++
thetitle (toHtml (doctitle ++ " (Index)")) +++
@@ -578,7 +579,7 @@ ppHtmlModule odir doctitle
footer)
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, moduleHtmlFile mdl]) (renderToString html)
+ writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString html)
ppHtmlModuleMiniSynopsis odir doctitle iface unicode
ppHtmlModuleMiniSynopsis :: FilePath -> String -> Interface -> Bool -> IO ()
@@ -595,7 +596,7 @@ ppHtmlModuleMiniSynopsis odir _doctitle iface unicode = do
<< toHtml (moduleString mdl)) +++
miniSynopsis mdl iface unicode)
createDirectoryIfMissing True odir
- writeFile (pathJoin [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString html)
+ writeFile (joinPath [odir, "mini_" ++ moduleHtmlFile mdl]) (renderToString html)
ifaceToHtml :: SourceURLs -> WikiURLs -> Interface -> Bool -> Html
ifaceToHtml maybe_source_url maybe_wiki_url iface unicode
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index 9a712d70..a4883078 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -21,7 +21,7 @@ module Haddock.Utils (
contentsHtmlFile, indexHtmlFile,
frameIndexHtmlFile,
moduleIndexFrameName, mainFrameName, synopsisFrameName,
- subIndexHtmlFile, pathJoin,
+ subIndexHtmlFile,
anchorNameStr,
cssFile, iconFile, jsFile, plusFile, minusFile, framesFile,
@@ -165,7 +165,7 @@ moduleHtmlFile :: Module -> FilePath
moduleHtmlFile mdl =
case Map.lookup mdl html_xrefs of
Nothing -> mdl' ++ ".html"
- Just fp0 -> pathJoin [fp0, mdl' ++ ".html"]
+ Just fp0 -> joinPath [fp0, mdl' ++ ".html"]
where
mdl' = map (\c -> if c == '.' then '-' else c)
(moduleNameString (moduleName mdl))
@@ -204,16 +204,6 @@ anchorNameStr name | isValOcc name = "v:" ++ occNameString name
| otherwise = "t:" ++ occNameString name
-pathJoin :: [FilePath] -> FilePath
-pathJoin = foldr join []
- where join :: FilePath -> FilePath -> FilePath
- join path1 "" = path1
- join "" path2 = path2
- join path1 path2
- | isPathSeparator (last path1) = path1++path2
- | otherwise = path1++pathSeparator:path2
-
-
-- -----------------------------------------------------------------------------
-- Files we need to copy from our $libdir