X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=utils%2Fghc-pkg%2FMain.hs;h=4b376848afa4649a8070161aff71691de709110a;hb=ad9d754d2b18d4dd027884e082c20777a29ef7d4;hp=896fd7c4747d9a73772e3be2cc50797e7d3ff6d8;hpb=cc318c842a9d6bbc90a7ef3f24450b4cbac0e2c8;p=ghc-hetmet.git diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 896fd7c..4b37684 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -18,28 +18,26 @@ module Main (main) where import Version ( version, targetOS, targetARCH ) import Distribution.InstalledPackageInfo import Distribution.Compat.ReadP -import Distribution.ParseUtils ( showError ) +import Distribution.ParseUtils import Distribution.Package import Distribution.Version -import Compat.Directory ( getAppUserDataDirectory, createDirectoryIfMissing ) -import Compat.RawSystem ( rawSystem ) + +#ifdef USING_COMPAT +import Compat.Directory ( getAppUserDataDirectory, createDirectoryIfMissing ) +import Compat.RawSystem ( rawSystem ) +#else +import System.Directory ( getAppUserDataDirectory, createDirectoryIfMissing ) +import System.Cmd ( rawSystem ) +#endif import Prelude #include "../../includes/ghcconfig.h" -#if __GLASGOW_HASKELL__ >= 504 import System.Console.GetOpt import Text.PrettyPrint import qualified Control.Exception as Exception import Data.Maybe -#else -import GetOpt -import Pretty -import qualified Exception -import Maybe -#endif - import Data.Char ( isSpace ) import Monad import Directory @@ -47,21 +45,12 @@ import System ( getArgs, getProgName, getEnv, exitWith, ExitCode(..) ) import System.IO -#if __GLASGOW_HASKELL__ >= 600 import System.IO.Error (try) -#else -import System.IO (try) -#endif import Data.List ( isPrefixOf, isSuffixOf, intersperse, sortBy ) #ifdef mingw32_HOST_OS import Foreign - -#if __GLASGOW_HASKELL__ >= 504 import Foreign.C.String -#else -import CString -#endif #endif import IO ( isPermissionError, isDoesNotExistError ) @@ -429,7 +418,9 @@ parsePackageInfo parsePackageInfo str defines = case parseInstalledPackageInfo str of ParseOk _warns ok -> return ok - ParseFailed err -> die (showError err) + ParseFailed err -> case locatedErrorMsg err of + (Nothing, s) -> die s + (Just l, s) -> die (show l ++ ": " ++ s) -- ----------------------------------------------------------------------------- -- Exposing, Hiding, Unregistering are all similar @@ -650,7 +641,9 @@ writeNewConfig filename packages = do if isPermissionError e then die (filename ++ ": you don't have permission to modify this file") else ioError e - hPutStrLn h (show packages) + let shown = concat $ intersperse ",\n " $ map show packages + fileContents = "[" ++ shown ++ "\n]" + hPutStrLn h fileContents hClose h hPutStrLn stdout "done."