From ff21a38c1b219a512e71c133b1c904a16b985265 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Tue, 27 Mar 2001 14:10:34 +0000
Subject: [PATCH] [project @ 2001-03-27 14:10:34 by simonmar] - add
 --show-package option to display the config info for a
 particular   package.

- add --field info, for use with --show-package, which displays the
  contents of the given field in the package config only.  The field
  is displayed one string per line.
---
 ghc/utils/ghc-pkg/Main.hs    |   41 ++++++++++++++++++++++++++++++++++++-----
 ghc/utils/ghc-pkg/Package.hs |   15 +++++++++------
 2 files changed, 45 insertions(+), 11 deletions(-)

diff --git a/ghc/utils/ghc-pkg/Main.hs b/ghc/utils/ghc-pkg/Main.hs
index f126609..139ce87 100644
--- a/ghc/utils/ghc-pkg/Main.hs
+++ b/ghc/utils/ghc-pkg/Main.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.7 2001/03/27 13:38:03 simonmar Exp $
+-- $Id: Main.hs,v 1.8 2001/03/27 14:10:34 simonmar Exp $
 --
 -- Package management tool
 -----------------------------------------------------------------------------
@@ -26,9 +26,10 @@ main = do
 	(_,_,errors) -> die (concat errors ++ 
 			     usageInfo usageHeader flags)
 
-data Flag = Config String | List | Add | Remove String
-isConfig (Config _) = True
-isConfig _ = False
+data Flag = Config String | List | Add | Remove String | Show String | Field String
+isConfigOrField (Config _) = True
+isConfigOrField (Field _) = True
+isConfigOrField _ = False
 
 usageHeader = "ghc-pkg [OPTION...]"
 
@@ -39,6 +40,10 @@ flags = [
  	"List the currently installed packages",
   Option ['a'] ["add-package"] (NoArg Add)
  	"Add a new package",
+  Option ['s'] ["show-package"] (ReqArg Show "NAME")
+ 	"Show the configuration for package NAME",
+  Option [] ["field"] (ReqArg Field "FIELD")
+ 	"(with --show-package) Show field FIELD only",
   Option ['r'] ["remove-package"] (ReqArg Remove "NAME")
  	"Remove an installed package"
   ]
@@ -50,14 +55,30 @@ runit clis = do
         [f] -> return f
         _   -> die (usageInfo usageHeader flags)
 
+  let toField "import_dirs"     = return import_dirs
+      toField "source_dirs"     = return source_dirs
+      toField "library_dirs"    = return library_dirs
+      toField "hs_libraries"    = return hs_libraries
+      toField "extra_libraries" = return extra_libraries
+      toField "include_dirs"    = return include_dirs
+      toField "c_includes"      = return c_includes
+      toField "package_deps"    = return package_deps
+      toField "extra_ghc_opts"  = return extra_ghc_opts
+      toField "extra_cc_opts"   = return extra_cc_opts
+      toField "extra_ld_opts"   = return extra_ld_opts  
+      toField s			= die ("unknown field: `" ++ s ++ "'")
+
+  fields <- mapM toField [ f | Field f <- clis ]
+
   s <- readFile conf_file
   let details = read s :: [PackageConfig]
   eval_catch details (\_ -> die "parse error in package config file")
 
-  case [ c | c <- clis, not (isConfig c) ] of
+  case [ c | c <- clis, not (isConfigOrField c) ] of
     [ List ]     -> listPackages details
     [ Add  ]     -> addPackage details conf_file
     [ Remove p ] -> removePackage details conf_file p
+    [ Show p ]   -> showPackage details conf_file p fields
     _            -> die (usageInfo usageHeader flags)
 
 
@@ -67,6 +88,16 @@ listPackages details = do
   hPutChar stdout '\n'
   exitWith ExitSuccess
 
+showPackage :: [PackageConfig] -> FilePath -> String
+	 -> [PackageConfig->[String]] -> IO ()
+showPackage details pkgconf pkg_name fields =
+  case [ p | p <- details, name p == pkg_name ] of
+    []    -> die ("can't find package `" ++ pkg_name ++ "'")
+    [pkg] | null fields -> hPutStrLn stdout (render (dumpPkgGuts pkg))
+	  | otherwise   -> hPutStrLn stdout (render (vcat 
+				(map (vcat . map text) (map ($pkg) fields))))
+    _     -> die "showPackage: internal error"
+
 addPackage :: [PackageConfig] -> FilePath -> IO ()
 addPackage details pkgconf = do
   checkConfigAccess pkgconf
diff --git a/ghc/utils/ghc-pkg/Package.hs b/ghc/utils/ghc-pkg/Package.hs
index 51a8a93..ae330ab 100644
--- a/ghc/utils/ghc-pkg/Package.hs
+++ b/ghc/utils/ghc-pkg/Package.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: Package.hs,v 1.1 2001/03/15 15:51:38 simonmar Exp $
+-- $Id: Package.hs,v 1.2 2001/03/27 14:10:34 simonmar Exp $
 --
 -- Package configuration defn.
 -----------------------------------------------------------------------------
@@ -8,8 +8,10 @@
 module Package ( 
 	PackageConfig(..), defaultPackageConfig
 #ifdef WANT_PRETTY
-	,listPkgs 	-- :: [PackageConfig] -> String
-	,dumpPackages	-- :: [PackageConfig] -> String
+	, listPkgs	 	-- :: [PackageConfig] -> String
+	, dumpPackages		-- :: [PackageConfig] -> String
+	, dumpPkgGuts		-- :: PackageConfig -> Doc
+	, dumpFieldContents	-- :: [String] -> Doc
 #endif
  ) where
 #endif
@@ -83,8 +85,9 @@ dumpPkgGuts pkg =
       ])))
 
 dumpField :: String -> [String] -> Doc
-dumpField name val =
-   hang (text name <+> equals) 2
-        (brackets (sep (punctuate comma (map (text . show) val))))
+dumpField name val = hang (text name <+> equals) 2  (dumpFieldContents val)
+
+dumpFieldContents :: [String] -> Doc
+dumpFieldContents val = brackets (sep (punctuate comma (map (text . show) val)))
 #endif
 
-- 
1.7.10.4