From 8789db32595b2f9de24fc6a51dd9c35ea197a7d5 Mon Sep 17 00:00:00 2001
From: Simon Marlow <simonmar@microsoft.com>
Date: Fri, 16 Nov 2007 12:11:53 +0000
Subject: [PATCH] Disallow installing packages whose names  differ in case
 only. --force overrides.  Requested by Duncan Coutts, with
 a view to treating package names as case-insensitive in the
 future.

---
 utils/ghc-pkg/Main.hs |   16 ++++++++++++----
 1 file changed, 12 insertions(+), 4 deletions(-)

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 908a4c5..a89be04 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -40,7 +40,7 @@ import Text.PrettyPrint
 import qualified Control.Exception as Exception
 import Data.Maybe
 
-import Data.Char ( isSpace )
+import Data.Char ( isSpace, toLower )
 import Monad
 import Directory
 import System ( getArgs, getProgName, getEnv, exitWith, ExitCode(..) )
@@ -681,7 +681,7 @@ validatePackageConfig :: InstalledPackageInfo
                       -> IO ()
 validatePackageConfig pkg db_stack auto_ghci_libs update force = do
   checkPackageId pkg
-  checkDuplicates db_stack pkg update
+  checkDuplicates db_stack pkg update force
   mapM_ (checkDep db_stack force) (depends pkg)
   mapM_ (checkDir force) (importDirs pkg)
   mapM_ (checkDir force) (libraryDirs pkg)
@@ -703,8 +703,8 @@ checkPackageId ipi =
     []  -> die ("invalid package identifier: " ++ str)
     _   -> die ("ambiguous package identifier: " ++ str)
 
-checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> IO ()
-checkDuplicates db_stack pkg update = do
+checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Force -> IO ()
+checkDuplicates db_stack pkg update force = do
   let
         pkgid = package pkg
         (_top_db_name, pkgs) : _  = db_stack
@@ -714,6 +714,14 @@ checkDuplicates db_stack pkg update = do
   when (not update && (pkgid `elem` map package pkgs)) $
        die ("package " ++ showPackageId pkgid ++ " is already installed")
 
+  let
+        uncasep = map toLower . showPackageId
+        dups = filter ((== uncasep pkgid) . uncasep) (map package pkgs)
+
+  when (not (null dups)) $ dieOrForceAll force $
+        "Package names may be treated case-insensitively in the future.\n"++
+        "Package " ++ showPackageId pkgid ++
+        " overlaps with: " ++ unwords (map showPackageId dups)
 
 
 checkDir :: Force -> String -> IO ()
-- 
1.7.10.4