From: Simon Marlow <marlowsd@gmail.com>
Date: Mon, 18 Aug 2008 11:33:45 +0000 (+0000)
Subject: FIX #2521: trailing colon in GHC_PACKAGE_PATH
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=e4f46f5de1749a06a927d98f0195e208f5eff374;p=ghc-hetmet.git

FIX #2521: trailing colon in GHC_PACKAGE_PATH
This was broken in the System.FilePath switchover, since filepath's
splitSearchPath doesn't do what we want (it ignores empty
components on Windows, and treats them as "." on Unix).  So we use our
own hand-rolled version, just like GHC.
---

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index d743193..e204dbc 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -426,7 +426,7 @@ getPkgDatabases modify my_flags = do
                 Right path
                   | last cs == ""  -> init cs ++ sys_databases
                   | otherwise      -> cs
-                  where cs = splitSearchPath path
+                  where cs = parseSearchPath path
 
         -- The "global" database is always the one at the bottom of the stack.
         -- This is the database we modify by default.
@@ -1198,3 +1198,23 @@ writeFileAtomic targetFile content = do
     --TODO: remove this when takeDirectory/splitFileName is fixed
     --      to always return a valid dir
     (targetDir_,targetName) = splitFileName targetFile
+
+-- | The function splits the given string to substrings
+-- using 'isSearchPathSeparator'.
+parseSearchPath :: String -> [FilePath]
+parseSearchPath path = split path
+  where
+    split :: String -> [String]
+    split s =
+      case rest' of
+        []     -> [chunk]
+        _:rest -> chunk : split rest
+      where
+        chunk =
+          case chunk' of
+#ifdef mingw32_HOST_OS
+            ('\"':xs@(_:_)) | last xs == '\"' -> init xs
+#endif
+            _                                 -> chunk'
+
+        (chunk', rest') = break isSearchPathSeparator s