From 13847171a3b1733b876bff8e157f8c97c665d1a6 Mon Sep 17 00:00:00 2001 From: panne Date: Mon, 2 Aug 2004 21:12:27 +0000 Subject: [haddock @ 2004-08-02 21:12:25 by panne] Use pathJoin instead of low-level list-based manipulation for FilePaths --- src/HaddockDevHelp.hs | 2 +- src/HaddockHH.hs | 8 ++++---- src/HaddockHH2.hs | 12 ++++++------ src/HaddockHtml.hs | 15 +++++++-------- src/HaddockUtil.hs | 13 +++++++++---- 5 files changed, 27 insertions(+), 23 deletions(-) diff --git a/src/HaddockDevHelp.hs b/src/HaddockDevHelp.hs index 3ebfc1c3..23f3bfc6 100644 --- a/src/HaddockDevHelp.hs +++ b/src/HaddockDevHelp.hs @@ -32,7 +32,7 @@ ppDevHelpFile odir doctitle maybe_package ifaces = do nest 4 (ppList index) $+$ text "" $$ text "" - writeFile (odir ++ pathSeparator:devHelpFile) (render doc) + writeFile (pathJoin [odir, devHelpFile]) (render doc) where package = fromMaybe "pkg" maybe_package diff --git a/src/HaddockHH.hs b/src/HaddockHH.hs index d4dc07e8..e0e9a97a 100644 --- a/src/HaddockHH.hs +++ b/src/HaddockHH.hs @@ -30,7 +30,7 @@ ppHHContents odir doctitle maybe_package tree = do text "" $$ ppModuleTree tree $$ text "" - writeFile (odir ++ pathSeparator:contentsHHFile) (render html) + writeFile (pathJoin [odir, contentsHHFile]) (render html) where package = fromMaybe "pkg" maybe_package @@ -93,7 +93,7 @@ ppHHIndex odir maybe_package ifaces = do nest 4 (ppList index) $+$ text "" $$ text "" - writeFile (odir ++ pathSeparator:indexHHFile) (render html) + writeFile (pathJoin [odir, indexHHFile]) (render html) where package = fromMaybe "pkg" maybe_package @@ -138,7 +138,7 @@ ppHHProject odir doctitle maybe_package ifaces pkg_paths = do text indexHtmlFile $$ ppIndexFiles chars $$ ppLibFiles ("":pkg_paths) - writeFile (odir ++ pathSeparator:projectHHFile) (render doc) + writeFile (pathJoin [odir, projectHHFile]) (render doc) where package = fromMaybe "pkg" maybe_package @@ -162,7 +162,7 @@ ppHHProject odir doctitle maybe_package ifaces pkg_paths = do ppLibFiles paths where toPath fname | null path = fname - | otherwise = path++pathSeparator:fname + | otherwise = pathJoin [path, fname] ppLibFile fname = text (toPath fname) chars :: [Char] diff --git a/src/HaddockHH2.hs b/src/HaddockHH2.hs index 915f211d..d28e8181 100644 --- a/src/HaddockHH2.hs +++ b/src/HaddockHH2.hs @@ -30,7 +30,7 @@ ppHH2Contents odir doctitle maybe_package tree = do nest 4 (ppModuleTree [] tree) $+$ text "") $$ text "" - writeFile (odir ++ pathSeparator:contentsHH2File) (render doc) + writeFile (pathJoin [odir, contentsHH2File]) (render doc) where package = fromMaybe "pkg" maybe_package @@ -82,8 +82,8 @@ ppHH2Index odir maybe_package ifaces = do nest 4 (text "text contentsHtmlFile<>text "\"/>") $$ text "" $$ text "" - writeFile (odir ++ pathSeparator:indexKHH2File) (render docK) - writeFile (odir ++ pathSeparator:indexNHH2File) (render docN) + writeFile (pathJoin [odir, indexKHH2File]) (render docK) + writeFile (pathJoin [odir, indexNHH2File]) (render docN) where package = fromMaybe "pkg" maybe_package @@ -118,7 +118,7 @@ ppHH2Files odir maybe_package ifaces pkg_paths = do ppIndexFiles chars $$ ppLibFiles ("":pkg_paths)) $$ text "" - writeFile (odir ++ pathSeparator:filesHH2File) (render doc) + writeFile (pathJoin [odir, filesHH2File]) (render doc) where package = fromMaybe "pkg" maybe_package @@ -142,7 +142,7 @@ ppHH2Files odir maybe_package ifaces pkg_paths = do ppLibFiles paths where toPath fname | null path = fname - | otherwise = path++pathSeparator:fname + | otherwise = pathJoin [path, fname] ppLibFile fname = text "text (toPath fname)<>text "\"/>" chars :: [Char] @@ -176,4 +176,4 @@ ppHH2Collection odir doctitle maybe_package = do text "" $$ text "") $$ text "" - writeFile (odir ++ pathSeparator:collectionHH2File) (render doc) + writeFile (pathJoin [odir, collectionHH2File]) (render doc) diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index af690fbe..bf4d46ee 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -116,11 +116,11 @@ copyHtmlBits :: FilePath -> FilePath -> Maybe FilePath -> IO () copyHtmlBits odir libdir maybe_css = do let css_file = case maybe_css of - Nothing -> libdir ++ pathSeparator:cssFile + Nothing -> pathJoin [libdir, cssFile] Just f -> f - css_destination = odir ++ pathSeparator:cssFile + css_destination = pathJoin [odir, cssFile] copyLibFile f = do - copyFile (libdir ++ pathSeparator:f) (odir ++ pathSeparator:f) + copyFile (pathJoin [libdir, f]) (pathJoin [odir, f]) copyFile css_file css_destination mapM_ copyLibFile [ iconFile, plusFile, minusFile, jsFile ] @@ -229,7 +229,7 @@ ppHtmlContents odir doctitle maybe_package maybe_html_help_format maybe_index_ur s15 footer ) - writeFile (odir ++ pathSeparator:contentsHtmlFile) (renderHtml html) + writeFile (pathJoin [odir, contentsHtmlFile]) (renderHtml html) -- Generate contents page for Html Help if requested case maybe_html_help_format of @@ -315,7 +315,7 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format maybe_contents_ur when split_indices $ mapM_ (do_sub_index index) initialChars - writeFile (odir ++ pathSeparator:indexHtmlFile) (renderHtml html) + writeFile (pathJoin [odir, indexHtmlFile]) (renderHtml html) -- Generate index and contents page for Html Help if requested case maybe_html_help_format of @@ -345,8 +345,7 @@ ppHtmlIndex odir doctitle maybe_package maybe_html_help_format maybe_contents_ur do_sub_index this_ix c = unless (null index_part) $ - writeFile (odir ++ pathSeparator:subIndexHtmlFile c) - (renderHtml html) + writeFile (pathJoin [odir, subIndexHtmlFile c]) (renderHtml html) where html = header (thetitle (toHtml (doctitle ++ " (Index)")) +++ thelink ! [href cssFile, @@ -435,7 +434,7 @@ ppHtmlModule odir doctitle source_url ifaceToHtml mdl iface s15 footer ) - writeFile (odir ++ pathSeparator:moduleHtmlFile mdl) (renderHtml html) + writeFile (pathJoin [odir, moduleHtmlFile mdl]) (renderHtml html) ifaceToHtml :: String -> Interface -> HtmlTable ifaceToHtml _ iface diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs index f7dab157..f081a5fb 100644 --- a/src/HaddockUtil.hs +++ b/src/HaddockUtil.hs @@ -14,9 +14,8 @@ module HaddockUtil ( -- * Filename utilities basename, dirname, splitFilename3, - isPathSeparator, pathSeparator, moduleHtmlFile, nameHtmlRef, - contentsHtmlFile, indexHtmlFile, subIndexHtmlFile, + contentsHtmlFile, indexHtmlFile, subIndexHtmlFile, pathJoin, cssFile, iconFile, jsFile, plusFile, minusFile, -- * Miscellaneous utilities @@ -28,7 +27,7 @@ module HaddockUtil ( import HsSyn -import List ( intersect, isSuffixOf ) +import List ( intersect, isSuffixOf, intersperse ) import Maybe import IO ( hPutStr, stderr ) import System @@ -276,7 +275,7 @@ moduleHtmlFile :: String -> FilePath moduleHtmlFile mdl = case lookupFM html_xrefs (Module mdl) of Nothing -> mdl ++ ".html" - Just fp0 -> fp0 ++ pathSeparator : mdl ++ ".html" + Just fp0 -> pathJoin [fp0, mdl ++ ".html"] nameHtmlRef :: String -> HsName -> String nameHtmlRef mdl str = moduleHtmlFile mdl ++ '#':escapeStr (hsAnchorNameStr str) @@ -290,6 +289,12 @@ subIndexHtmlFile a = "doc-index-" ++ b ++ ".html" where b | isAlpha a = [a] | otherwise = show (ord a) +pathJoin :: [FilePath] -> FilePath +pathJoin = concat . intersperse pathSeparatorStr + +pathSeparatorStr :: String +pathSeparatorStr = [pathSeparator] + -- ----------------------------------------------------------------------------- -- Files we need to copy from our $libdir -- cgit v1.2.3