[commit: ghc] wip/remove-cabal-dep: Fix more warnings, remove now-dead code (1af0780)

git at git.haskell.org git at git.haskell.org
Fri Aug 22 15:38:49 UTC 2014


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/remove-cabal-dep
Link       : http://ghc.haskell.org/trac/ghc/changeset/1af0780fc57b5248444f94eacc86df46acf20821/ghc

>---------------------------------------------------------------

commit 1af0780fc57b5248444f94eacc86df46acf20821
Author: Duncan Coutts <duncan at well-typed.com>
Date:   Fri Aug 22 16:37:16 2014 +0100

    Fix more warnings, remove now-dead code
    
    Also remove more of the old file style ghc-pkg dbs that I missed previously.


>---------------------------------------------------------------

1af0780fc57b5248444f94eacc86df46acf20821
 compiler/main/PackageConfig.hs |  1 +
 utils/ghc-pkg/Main.hs          | 54 +++---------------------------------------
 2 files changed, 4 insertions(+), 51 deletions(-)

diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs
index 09ff065..63b2903 100644
--- a/compiler/main/PackageConfig.hs
+++ b/compiler/main/PackageConfig.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 -- |
 -- Package configuration information: essentially the interface to Cabal, with
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index b95a784..858797f 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, RecordWildCards,
              GeneralizedNewtypeDeriving, StandaloneDeriving #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 --
 -- (c) The University of Glasgow 2004-2009.
@@ -13,7 +14,6 @@ module Main (main) where
 import Version ( version, targetOS, targetARCH )
 import qualified GHC.PackageDb as GhcPkg
 import qualified Distribution.Simple.PackageIndex as PackageIndex
-import qualified Distribution.Package as Cabal
 import qualified Distribution.ModuleName as ModuleName
 import Distribution.ModuleName (ModuleName)
 import Distribution.InstalledPackageInfo as Cabal
@@ -976,12 +976,8 @@ data DBOp = RemovePackage InstalledPackageInfo
 changeDB :: Verbosity -> [DBOp] -> PackageDB -> IO ()
 changeDB verbosity cmds db = do
   let db' = updateInternalDB db cmds
-  isfile <- doesFileExist (location db)
-  if isfile
-     then writeNewConfig verbosity (location db') (packages db')
-     else do
-       createDirectoryIfMissing True (location db)
-       changeDBDir verbosity cmds db'
+  createDirectoryIfMissing True (location db)
+  changeDBDir verbosity cmds db'
 
 updateInternalDB :: PackageDB -> [DBOp] -> PackageDB
 updateInternalDB db cmds = db{ packages = foldl do_cmd (packages db) cmds }
@@ -1451,46 +1447,6 @@ closure pkgs db_stack = go pkgs db_stack
 brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo]
 brokenPackages pkgs = snd (closure [] pkgs)
 
--- -----------------------------------------------------------------------------
--- Manipulating package.conf files
-
-type InstalledPackageInfoString = InstalledPackageInfo_ String
-
-convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString
-convertPackageInfoOut
-    (pkgconf@(InstalledPackageInfo { exposedModules = e,
-                                     reexportedModules = r,
-                                     hiddenModules = h })) =
-        pkgconf{ exposedModules = map display e,
-                 reexportedModules = map (fmap display) r,
-                 hiddenModules  = map display h }
-
-convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo
-convertPackageInfoIn
-    (pkgconf@(InstalledPackageInfo { exposedModules = e,
-                                     reexportedModules = r,
-                                     hiddenModules = h })) =
-        pkgconf{ exposedModules = map convert e,
-                 reexportedModules = map (fmap convert) r,
-                 hiddenModules  = map convert h }
-    where convert = fromJust . simpleParse
-
-writeNewConfig :: Verbosity -> FilePath -> [InstalledPackageInfo] -> IO ()
-writeNewConfig verbosity filename ipis = do
-  when (verbosity >= Normal) $
-      info "Writing new package config file... "
-  createDirectoryIfMissing True $ takeDirectory filename
-  let shown = concat $ intersperse ",\n "
-                     $ map (show . convertPackageInfoOut) ipis
-      fileContents = "[" ++ shown ++ "\n]"
-  writeFileUtf8Atomic filename fileContents
-    `catchIO` \e ->
-      if isPermissionError e
-      then die (filename ++ ": you don't have permission to modify this file")
-      else ioError e
-  when (verbosity >= Normal) $
-      infoLn "done."
-
 -----------------------------------------------------------------------------
 -- Sanity-check a new package config, and automatically build GHCi libs
 -- if requested.
@@ -1943,10 +1899,6 @@ throwIOIO = Exception.throwIO
 catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
 catchIO = Exception.catch
 
-catchError :: IO a -> (String -> IO a) -> IO a
-catchError io handler = io `Exception.catch` handler'
-    where handler' (Exception.ErrorCall err) = handler err
-
 tryIO :: IO a -> IO (Either Exception.IOException a)
 tryIO = Exception.try
 



More information about the ghc-commits mailing list