Commit 29f84d30 authored by Duncan Coutts's avatar Duncan Coutts Committed by Edward Z. Yang
Browse files

Fix long lines and trailing whitespace

in the previous patches in this series
parent 6930a88c
......@@ -1117,7 +1117,8 @@ linkPackage dflags pkg
objs = [ obj | Object obj <- classifieds ]
archs = [ arch | Archive arch <- classifieds ]
maybePutStr dflags ("Loading package " ++ sourcePackageIdString pkg ++ " ... ")
maybePutStr dflags
("Loading package " ++ sourcePackageIdString pkg ++ " ... ")
-- See comments with partOfGHCi
when (packageName pkg `notElem` partOfGHCi) $ do
......@@ -1132,8 +1133,11 @@ linkPackage dflags pkg
maybePutStr dflags "linking ... "
ok <- resolveObjs
if succeeded ok then maybePutStrLn dflags "done."
else throwGhcExceptionIO (InstallationError ("unable to load package `" ++ sourcePackageIdString pkg ++ "'"))
if succeeded ok
then maybePutStrLn dflags "done."
else let errmsg = "unable to load package `"
++ sourcePackageIdString pkg ++ "'"
in throwGhcExceptionIO (InstallationError errmsg)
-- we have already searched the filesystem; the strings passed to load_dyn
-- can be passed directly to loadDLL. They are either fully-qualified
......
......@@ -616,13 +616,14 @@ cantFindErr cannot_find _ dflags mod_name find_result
hang (ptext (sLit "Locations searched:")) 2 $ vcat (map text files)
pkg_hidden pkgid =
ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkgid)
ptext (sLit "It is a member of the hidden package")
<+> quotes (ppr pkgid)
--FIXME: we don't really want to show the package key here we should
-- show the source package id or installed package id if it's ambiguous
<> dot $$ cabal_pkg_hidden_hint pkgid
cabal_pkg_hidden_hint pkgid
| gopt Opt_BuildingCabalPackage dflags
= let pkg = expectJust "cabal_pkg_hidden_hint" (lookupPackage dflags pkgid)
= let pkg = expectJust "pkg_hidden" (lookupPackage dflags pkgid)
in ptext (sLit "Perhaps you need to add") <+>
quotes (ppr (packageName pkg)) <+>
ptext (sLit "to the build-depends in your .cabal file.")
......
......@@ -68,7 +68,7 @@ instance BinaryStringRep PackageKey where
instance BinaryStringRep Module.ModuleName where
fromStringRep = Module.mkModuleName . BS.unpack
toStringRep = BS.pack . Module.moduleNameString
toStringRep = BS.pack . Module.moduleNameString
instance Outputable InstalledPackageId where
ppr (InstalledPackageId str) = text str
......
......@@ -391,9 +391,10 @@ readPackageConfig dflags conf_file = do
isfile <- doesFileExist conf_file
if isfile
then throwGhcExceptionIO $ InstallationError $
"ghc no longer supports single-file style package databases (" ++
conf_file ++
") use 'ghc-pkg init' to create the database with the correct format."
"ghc no longer supports single-file style package " ++
"databases (" ++ conf_file ++
") use 'ghc-pkg init' to create the database with " ++
"the correct format."
else throwGhcExceptionIO $ InstallationError $
"can't find a package database at " ++ conf_file
......@@ -597,7 +598,8 @@ packageFlagErr dflags flag reasons
-- ToDo: this admonition seems a bit dodgy
text "(use -v for more information)")
ppr_reasons = vcat (map ppr_reason reasons)
ppr_reason (p, reason) = pprReason (ppr (installedPackageId p) <+> text "is") reason
ppr_reason (p, reason) =
pprReason (ppr (installedPackageId p) <+> text "is") reason
pprFlag :: PackageFlag -> SDoc
pprFlag flag = case flag of
......@@ -692,7 +694,9 @@ findWiredInPackages dflags pkgs = do
updateWiredInDependencies pkgs = map upd_pkg pkgs
where upd_pkg pkg
| installedPackageId pkg `elem` wired_in_ids
= pkg { packageKey = stringToPackageKey (packageNameString pkg) }
= pkg {
packageKey = stringToPackageKey (packageNameString pkg)
}
| otherwise
= pkg
......
......@@ -34,7 +34,7 @@
-- the second version -- the bit GHC uses -- and the part managed by ghc-pkg
-- is kept in the file but here we treat it as an opaque blob of data. That way
-- this library avoids depending on Cabal.
--
--
module GHC.PackageDb (
InstalledPackageInfo(..),
ModuleExport(..),
......@@ -106,7 +106,8 @@ data ModuleExport instpkgid modulename
}
deriving (Eq, Show)
emptyInstalledPackageInfo :: (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c, BinaryStringRep d)
emptyInstalledPackageInfo :: (BinaryStringRep a, BinaryStringRep b,
BinaryStringRep c, BinaryStringRep d)
=> InstalledPackageInfo a b c d e
emptyInstalledPackageInfo =
InstalledPackageInfo {
......@@ -230,17 +231,17 @@ decodeFromFile file decoder =
withBinaryFile file ReadMode $ \hnd ->
feed hnd (runGetIncremental decoder)
where
feed hnd (Partial k) = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize
if BS.null chunk
then feed hnd (k Nothing)
else feed hnd (k (Just chunk))
feed _ (Done _ _ result) = return result
feed _ (Fail _ _ msg) = ioError err
feed hnd (Partial k) = do chunk <- BS.hGet hnd BS.Lazy.defaultChunkSize
if BS.null chunk
then feed hnd (k Nothing)
else feed hnd (k (Just chunk))
feed _ (Done _ _ res) = return res
feed _ (Fail _ _ msg) = ioError err
where
err = mkIOError InappropriateType loc Nothing (Just file)
`ioeSetErrorString` msg
loc = "GHC.PackageDb.readPackageDb"
writeFileAtomic :: FilePath -> BS.Lazy.ByteString -> IO ()
writeFileAtomic targetPath content = do
let (targetDir, targetName) = splitFileName targetPath
......@@ -272,7 +273,8 @@ instance (BinaryStringRep a, BinaryStringRep b, BinaryStringRep c,
BinaryStringRep d, BinaryStringRep e) =>
Binary (InstalledPackageInfo a b c d e) where
put (InstalledPackageInfo
installedPackageId sourcePackageId packageName packageVersion packageKey
installedPackageId sourcePackageId
packageName packageVersion packageKey
depends importDirs
hsLibraries extraLibraries extraGHCiLibraries libraryDirs
frameworks frameworkDirs
......@@ -357,7 +359,8 @@ instance Binary Version where
b <- get
return (Version a b)
instance (BinaryStringRep a, BinaryStringRep b) => Binary (ModuleExport a b) where
instance (BinaryStringRep a, BinaryStringRep b) =>
Binary (ModuleExport a b) where
put (ModuleExport a b c) = do
put (toStringRep a)
put (toStringRep b)
......
......@@ -681,9 +681,9 @@ readParseDatabase verbosity mb_user_conf modify use_cache path
case e of
Left err
| ioeGetErrorType err == InappropriateType ->
die ("ghc no longer supports single-file style package databases ("
++ path ++ ") use 'ghc-pkg init' to create the database with "
++ "the correct format.")
die ("ghc no longer supports single-file style package databases "
++ "(" ++ path ++ ") use 'ghc-pkg init' to create the database "
++ "with the correct format.")
| otherwise -> ioError err
Right fs
| not use_cache -> ignore_cache (const $ return ())
......@@ -693,13 +693,17 @@ readParseDatabase verbosity mb_user_conf modify use_cache path
e_tcache <- tryIO $ getModificationTime cache
case e_tcache of
Left ex -> do
when (verbosity >= Normal && not modify || verbosity > Normal) $ do
if isDoesNotExistError ex
then do warn ("WARNING: cache does not exist: " ++ cache)
warn "ghc will fail to read this package db. Use 'ghc-pkg recache' to fix."
else do warn ("WARNING: cache cannot be read: " ++ show ex)
warn "ghc will fail to read this package db."
ignore_cache (const $ return ())
when ( verbosity > Normal
|| verbosity >= Normal && not modify) $
if isDoesNotExistError ex
then do
warn ("WARNING: cache does not exist: " ++ cache)
warn ("ghc will fail to read this package db. " ++
"Use 'ghc-pkg recache' to fix.")
else do
warn ("WARNING: cache cannot be read: " ++ show ex)
warn "ghc will fail to read this package db."
ignore_cache (const $ return ())
Right tcache -> do
let compareTimestampToCache file =
when (verbosity >= Verbose) $ do
......@@ -722,10 +726,11 @@ readParseDatabase verbosity mb_user_conf modify use_cache path
pkgs <- GhcPkg.readPackageDbForGhcPkg cache
mkPackageDB pkgs
else do
when (verbosity >= Normal && not modify || verbosity > Normal) $ do
warn ("WARNING: cache is out of date: "
++ cache)
warn "ghc will see an old view of this package db. Use 'ghc-pkg recache' to fix."
when ( verbosity > Normal
|| verbosity >= Normal && not modify) $ do
warn ("WARNING: cache is out of date: " ++ cache)
warn ("ghc will see an old view of this " ++
"package db. Use 'ghc-pkg recache' to fix.")
ignore_cache compareTimestampToCache
where
ignore_cache :: (FilePath -> IO ()) -> IO PackageDB
......@@ -844,8 +849,8 @@ registerPackage :: FilePath
registerPackage input verbosity my_flags auto_ghci_libs multi_instance
expand_env_vars update force = do
(db_stack, Just to_modify, _flag_dbs) <-
getPkgDatabases verbosity True{-modify-} True{-use user-} True{-use cache-}
False{-expand vars-} my_flags
getPkgDatabases verbosity True{-modify-} True{-use user-}
True{-use cache-} False{-expand vars-} my_flags
let
db_to_operate_on = my_head "register" $
......@@ -1027,7 +1032,12 @@ updateDBCache verbosity db = do
setFileTimes (location db) (accessTime status) (modificationTime status)
#endif
type PackageCacheFormat = GhcPkg.InstalledPackageInfo String String String String ModuleName
type PackageCacheFormat = GhcPkg.InstalledPackageInfo
String -- installed package id
String -- src package id
String -- package name
String -- package key
ModuleName -- module name
convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
convertPackageInfoToCacheFormat pkg =
......@@ -1056,7 +1066,8 @@ convertPackageInfoToCacheFormat pkg =
GhcPkg.reexportedModules = [ GhcPkg.ModuleExport m ipid' m'
| ModuleExport {
exportName = m,
exportCachedTrueOrig = Just (InstalledPackageId ipid', m')
exportCachedTrueOrig =
Just (InstalledPackageId ipid', m')
} <- reexportedModules pkg
],
GhcPkg.exposed = exposed pkg,
......@@ -1099,8 +1110,8 @@ modifyPackage
-> IO ()
modifyPackage fn pkgarg verbosity my_flags force = do
(db_stack, Just _to_modify, flag_dbs) <-
getPkgDatabases verbosity True{-modify-} True{-use user-} True{-use cache-}
False{-expand vars-} my_flags
getPkgDatabases verbosity True{-modify-} True{-use user-}
True{-use cache-} False{-expand vars-} my_flags
-- Do the search for the package respecting flags...
(db, ps) <- fmap head $ findPackagesByDB flag_dbs pkgarg
......@@ -1153,8 +1164,8 @@ listPackages :: Verbosity -> [Flag] -> Maybe PackageArg
listPackages verbosity my_flags mPackageName mModuleName = do
let simple_output = FlagSimpleOutput `elem` my_flags
(db_stack, _, flag_db_stack) <-
getPkgDatabases verbosity False{-modify-} False{-use user-} True{-use cache-}
False{-expand vars-} my_flags
getPkgDatabases verbosity False{-modify-} False{-use user-}
True{-use cache-} False{-expand vars-} my_flags
let db_stack_filtered -- if a package is given, filter out all other packages
| Just this <- mPackageName =
......@@ -1255,8 +1266,8 @@ simplePackageList my_flags pkgs = do
showPackageDot :: Verbosity -> [Flag] -> IO ()
showPackageDot verbosity myflags = do
(_, _, flag_db_stack) <-
getPkgDatabases verbosity False{-modify-} False{-use user-} True{-use cache-}
False{-expand vars-} myflags
getPkgDatabases verbosity False{-modify-} False{-use user-}
True{-use cache-} False{-expand vars-} myflags
let all_pkgs = allPackagesInStack flag_db_stack
ipix = PackageIndex.fromList all_pkgs
......@@ -1280,8 +1291,8 @@ showPackageDot verbosity myflags = do
latestPackage :: Verbosity -> [Flag] -> PackageIdentifier -> IO ()
latestPackage verbosity my_flags pkgid = do
(_, _, flag_db_stack) <-
getPkgDatabases verbosity False{-modify-} False{-use user-} True{-use cache-}
False{-expand vars-} my_flags
getPkgDatabases verbosity False{-modify-} False{-use user-}
True{-use cache-} False{-expand vars-} my_flags
ps <- findPackages flag_db_stack (Id pkgid)
case ps of
......@@ -1296,8 +1307,8 @@ latestPackage verbosity my_flags pkgid = do
describePackage :: Verbosity -> [Flag] -> PackageArg -> Bool -> IO ()
describePackage verbosity my_flags pkgarg expand_pkgroot = do
(_, _, flag_db_stack) <-
getPkgDatabases verbosity False{-modify-} False{-use user-} True{-use cache-}
expand_pkgroot my_flags
getPkgDatabases verbosity False{-modify-} False{-use user-}
True{-use cache-} expand_pkgroot my_flags
dbs <- findPackagesByDB flag_db_stack pkgarg
doDump expand_pkgroot [ (pkg, locationAbsolute db)
| (db, pkgs) <- dbs, pkg <- pkgs ]
......@@ -1305,8 +1316,8 @@ describePackage verbosity my_flags pkgarg expand_pkgroot = do
dumpPackages :: Verbosity -> [Flag] -> Bool -> IO ()
dumpPackages verbosity my_flags expand_pkgroot = do
(_, _, flag_db_stack) <-
getPkgDatabases verbosity False{-modify-} False{-use user-} True{-use cache-}
expand_pkgroot my_flags
getPkgDatabases verbosity False{-modify-} False{-use user-}
True{-use cache-} expand_pkgroot my_flags
doDump expand_pkgroot [ (pkg, locationAbsolute db)
| db <- flag_db_stack, pkg <- packages db ]
......@@ -1362,8 +1373,8 @@ matchesPkg :: PackageArg -> InstalledPackageInfo -> Bool
describeField :: Verbosity -> [Flag] -> PackageArg -> [String] -> Bool -> IO ()
describeField verbosity my_flags pkgarg fields expand_pkgroot = do
(_, _, flag_db_stack) <-
getPkgDatabases verbosity False{-modify-} False{-use user-} True{-use cache-}
expand_pkgroot my_flags
getPkgDatabases verbosity False{-modify-} False{-use user-}
True{-use cache-} expand_pkgroot my_flags
fns <- mapM toField fields
ps <- findPackages flag_db_stack pkgarg
mapM_ (selectFields fns) ps
......@@ -1382,9 +1393,11 @@ describeField verbosity my_flags pkgarg fields expand_pkgroot = do
checkConsistency :: Verbosity -> [Flag] -> IO ()
checkConsistency verbosity my_flags = do
(db_stack, _, _) <-
getPkgDatabases verbosity False{-modify-} True{-use user-} True{-use cache-} True{-expand vars-} my_flags
getPkgDatabases verbosity False{-modify-} True{-use user-}
True{-use cache-} True{-expand vars-}
my_flags
-- although check is not a modify command, we do need to use the user
-- db, because ordering is important.
-- db, because we may need it to verify package deps.
let simple_output = FlagSimpleOutput `elem` my_flags
......@@ -2066,7 +2079,7 @@ getInstalledPackageInfo = do
instance Binary PackageIdentifier where
put pid = do put (pkgName pid); put (pkgVersion pid)
get = do
get = do
pkgName <- get
pkgVersion <- get
return PackageIdentifier{..}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment