FIX #1837: remove deprecated support for unversioned dependencies (do not merge)

[ghc-hetmet.git] / utils / ghc-pkg / Main.hs

diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 8c106b0..2157d07 100644 (file)
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -62,7 +62,7 @@ main :: IO ()
 main = do
   args <- getArgs
 
 main = do
   args <- getArgs
 

-  case getOpt Permute flags args of
+  case getOpt Permute (flags ++ deprecFlags) args of

         (cli,_,[]) | FlagHelp `elem` cli -> do
            prog <- getProgramName
            bye (usageInfo (usageHeader prog) flags)
         (cli,_,[]) | FlagHelp `elem` cli -> do
            prog <- getProgramName
            bye (usageInfo (usageHeader prog) flags)

@@ -120,8 +120,6 @@ flags = [
         "automatically build libs for GHCi (with register)",
   Option ['?'] ["help"] (NoArg FlagHelp)
         "display this help and exit",
         "automatically build libs for GHCi (with register)",
   Option ['?'] ["help"] (NoArg FlagHelp)
         "display this help and exit",

-  Option ['D'] ["define-name"] (ReqArg toDefined "NAME=VALUE")
-          "define NAME as VALUE",

   Option ['V'] ["version"] (NoArg FlagVersion)
         "output version information and exit",
   Option [] ["simple-output"] (NoArg FlagSimpleOutput)
   Option ['V'] ["version"] (NoArg FlagVersion)
         "output version information and exit",
   Option [] ["simple-output"] (NoArg FlagSimpleOutput)

@@ -129,7 +127,13 @@ flags = [
   Option [] ["names-only"] (NoArg FlagNamesOnly)
         "only print package names, not versions; can only be used with list --simple-output"
   ]
   Option [] ["names-only"] (NoArg FlagNamesOnly)
         "only print package names, not versions; can only be used with list --simple-output"
   ]

- where
+
+deprecFlags :: [OptDescr Flag]
+deprecFlags = [
+  Option ['D'] ["define-name"] (ReqArg toDefined "NAME=VALUE")
+          "define NAME as VALUE"
+  ]
+  where

   toDefined str =
     case break (=='=') str of
       (nm,[])    -> FlagDefinedName nm []
   toDefined str =
     case break (=='=') str of
       (nm,[])    -> FlagDefinedName nm []

@@ -220,10 +224,12 @@ runit cli nonopts = do
         pkgid <- readGlobPkgId pkgid_str
         hidePackage pkgid cli
     ["list"] -> do
         pkgid <- readGlobPkgId pkgid_str
         hidePackage pkgid cli
     ["list"] -> do

-        listPackages cli Nothing
+        listPackages cli Nothing Nothing

     ["list", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
     ["list", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str

-        listPackages cli (Just pkgid)
+        listPackages cli (Just pkgid) Nothing
+    ["find-module", moduleName] -> do
+        listPackages cli Nothing (Just moduleName)

     ["latest", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
         latestPackage cli pkgid
     ["latest", pkgid_str] -> do
         pkgid <- readGlobPkgId pkgid_str
         latestPackage cli pkgid

@@ -404,10 +410,9 @@ registerPackage input defines flags auto_ghci_libs update force = do
 
   expanded <- expandEnvVars s defines force
 
 
   expanded <- expandEnvVars s defines force
 

-  pkg0 <- parsePackageInfo expanded defines
+  pkg <- parsePackageInfo expanded defines

   putStrLn "done."
 
   putStrLn "done."
 

-  let pkg = resolveDeps db_stack pkg0

   validatePackageConfig pkg db_stack auto_ghci_libs update force
   let new_details = filter not_this (snd db_to_operate_on) ++ [pkg]
       not_this p = package p /= package pkg
   validatePackageConfig pkg db_stack auto_ghci_libs update force
   let new_details = filter not_this (snd db_to_operate_on) ++ [pkg]
       not_this p = package p /= package pkg

@@ -457,14 +462,17 @@ modifyPackage fn pkgid flags  = do
 -- -----------------------------------------------------------------------------
 -- Listing packages
 
 -- -----------------------------------------------------------------------------
 -- Listing packages
 

-listPackages ::  [Flag] -> Maybe PackageIdentifier -> IO ()
-listPackages flags mPackageName = do
+listPackages ::  [Flag] -> Maybe PackageIdentifier -> Maybe String -> IO ()
+listPackages flags mPackageName mModuleName = do

   let simple_output = FlagSimpleOutput `elem` flags
   db_stack <- getPkgDatabases False flags
   let db_stack_filtered -- if a package is given, filter out all other packages
         | Just this <- mPackageName =
             map (\(conf,pkgs) -> (conf, filter (this `matchesPkg`) pkgs))
                 db_stack
   let simple_output = FlagSimpleOutput `elem` flags
   db_stack <- getPkgDatabases False flags
   let db_stack_filtered -- if a package is given, filter out all other packages
         | Just this <- mPackageName =
             map (\(conf,pkgs) -> (conf, filter (this `matchesPkg`) pkgs))
                 db_stack

+        | Just this <- mModuleName = -- packages which expose mModuleName
+            map (\(conf,pkgs) -> (conf, filter (this `exposedInPkg`) pkgs))
+                db_stack

         | otherwise = db_stack
 
       db_stack_sorted
         | otherwise = db_stack
 
       db_stack_sorted

@@ -542,6 +550,9 @@ pid `matchesPkg` pkg = pid `matches` package pkg
 compPkgIdVer :: PackageIdentifier -> PackageIdentifier -> Ordering
 compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2
 
 compPkgIdVer :: PackageIdentifier -> PackageIdentifier -> Ordering
 compPkgIdVer p1 p2 = pkgVersion p1 `compare` pkgVersion p2
 

+exposedInPkg :: String -> InstalledPackageInfo -> Bool
+moduleName `exposedInPkg` pkg = moduleName `elem` exposedModules pkg
+

 -- -----------------------------------------------------------------------------
 -- Field
 
 -- -----------------------------------------------------------------------------
 -- Field
 

@@ -556,7 +567,7 @@ describeField flags pkgid field = do
         mapM_ (putStrLn . fn) (mungePackagePaths top_dir ps)
 
 mungePackagePaths :: String -> [InstalledPackageInfo] -> [InstalledPackageInfo]
         mapM_ (putStrLn . fn) (mungePackagePaths top_dir ps)
 
 mungePackagePaths :: String -> [InstalledPackageInfo] -> [InstalledPackageInfo]

--- Replace the string "$topdir" at the beginning of a path
+-- Replace the strings "$topdir" and "$httptopdir" at the beginning of a path

 -- with the current topdir (obtained from the -B option).
 mungePackagePaths top_dir ps = map munge_pkg ps
   where
 -- with the current topdir (obtained from the -B option).
 mungePackagePaths top_dir ps = map munge_pkg ps
   where

@@ -571,8 +582,11 @@ mungePackagePaths top_dir ps = map munge_pkg ps
   munge_paths = map munge_path
 
   munge_path p
   munge_paths = map munge_path
 
   munge_path p

-          | Just p' <- maybePrefixMatch "$topdir" p = top_dir ++ p'
-          | otherwise                               = p
+   | Just p' <- maybePrefixMatch "$topdir"     p =            top_dir ++ p'
+   | Just p' <- maybePrefixMatch "$httptopdir" p = toHttpPath top_dir ++ p'
+   | otherwise                               = p
+
+  toHttpPath p = "file:///" ++ p

 
 maybePrefixMatch :: String -> String -> Maybe String
 maybePrefixMatch []    rest = Just rest
 
 maybePrefixMatch :: String -> String -> Maybe String
 maybePrefixMatch []    rest = Just rest

@@ -712,32 +726,6 @@ checkPackageId ipi =
     []  -> die ("invalid package identifier: " ++ str)
     _   -> die ("ambiguous package identifier: " ++ str)
 
     []  -> die ("invalid package identifier: " ++ str)
     _   -> die ("ambiguous package identifier: " ++ str)
 

-resolveDeps :: PackageDBStack -> InstalledPackageInfo -> InstalledPackageInfo
-resolveDeps db_stack p = updateDeps p
-  where
-        -- The input package spec is allowed to give a package dependency
-        -- without a version number; e.g.
-        --      depends: base
-        -- Here, we update these dependencies without version numbers to
-        -- match the actual versions of the relevant packages installed.
-        updateDeps p = p{depends = map resolveDep (depends p)}
-
-        resolveDep dep_pkgid
-           | realVersion dep_pkgid  = dep_pkgid
-           | otherwise              = lookupDep dep_pkgid
-
-        lookupDep dep_pkgid
-           = let
-                name = pkgName dep_pkgid
-             in
-             case [ pid | p <- concat (map snd db_stack),
-                          let pid = package p,
-                          pkgName pid == name ] of
-                (pid:_) -> pid          -- Found installed package,
-                                        -- replete with its version
-                []      -> dep_pkgid    -- No installed package; use
-                                        -- the version-less one
-

 checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> IO ()
 checkDuplicates db_stack pkg update = do
   let
 checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> IO ()
 checkDuplicates db_stack pkg update = do
   let

@@ -753,8 +741,9 @@ checkDuplicates db_stack pkg update = do
 
 checkDir :: Force -> String -> IO ()
 checkDir force d
 
 checkDir :: Force -> String -> IO ()
 checkDir force d

- | "$topdir" `isPrefixOf` d = return ()
-        -- can't check this, because we don't know what $topdir is
+ | "$topdir"     `isPrefixOf` d = return ()
+ | "$httptopdir" `isPrefixOf` d = return ()
+        -- can't check these, because we don't know what $(http)topdir is

  | otherwise = do
    there <- doesDirectoryExist d
    when (not there)
  | otherwise = do
    there <- doesDirectoryExist d
    when (not there)

@@ -790,7 +779,8 @@ checkHSLib dirs auto_ghci_libs force lib = do
 
 doesLibExistIn :: String -> String -> IO Bool
 doesLibExistIn lib d
 
 doesLibExistIn :: String -> String -> IO Bool
 doesLibExistIn lib d

- | "$topdir" `isPrefixOf` d = return True
+ | "$topdir"     `isPrefixOf` d = return True
+ | "$httptopdir" `isPrefixOf` d = return True

  | otherwise                = doesFileExist (d ++ '/':lib)
 
 checkGHCiLib :: [String] -> String -> String -> String -> Bool -> IO ()
  | otherwise                = doesFileExist (d ++ '/':lib)
 
 checkGHCiLib :: [String] -> String -> String -> String -> Bool -> IO ()

@@ -942,8 +932,8 @@ oldRunit clis = do
       defines = [ (nm,val) | OF_DefinedName nm val <- clis ]
 
   case [ c | c <- clis, isAction c ] of
       defines = [ (nm,val) | OF_DefinedName nm val <- clis ]
 
   case [ c | c <- clis, isAction c ] of

-    [ OF_List ]      -> listPackages new_flags Nothing
-    [ OF_ListLocal ] -> listPackages new_flags Nothing
+    [ OF_List ]      -> listPackages new_flags Nothing Nothing
+    [ OF_ListLocal ] -> listPackages new_flags Nothing Nothing

     [ OF_Add upd ]   ->
         registerPackage input_file defines new_flags auto_ghci_libs upd force
     [ OF_Remove pkgid_str ]  -> do
     [ OF_Add upd ]   ->
         registerPackage input_file defines new_flags auto_ghci_libs upd force
     [ OF_Remove pkgid_str ]  -> do