diff options
-rw-r--r-- | src/Haddock/Backends/DevHelp.hs | 3 | ||||
-rw-r--r-- | src/Haddock/Backends/HH.hs | 8 | ||||
-rw-r--r-- | src/Haddock/Backends/HH2.hs | 12 | ||||
-rw-r--r-- | src/Haddock/Backends/Html.hs | 21 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 21 | ||||
-rw-r--r-- | src/Haddock/Utils.hs | 14 |
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 |