Fix long lines and trailing whitespace
authorDuncan Coutts <duncan@well-typed.com>
Sat, 23 Aug 2014 12:12:20 +0000 (13:12 +0100)
committerEdward Z. Yang <ezyang@cs.stanford.edu>
Fri, 29 Aug 2014 11:39:04 +0000 (12:39 +0100)
in the previous patches in this series

compiler/ghci/Linker.lhs
compiler/main/Finder.lhs
compiler/main/PackageConfig.hs
compiler/main/Packages.lhs
libraries/bin-package-db/GHC/PackageDb.hs
utils/ghc-pkg/Main.hs

index f581f9f..d4de513 100644 (file)
@@ -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
index 8b9a5e9..65151d9 100644 (file)
@@ -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.")
index 09ff065..7cd2779 100644 (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
index cf9ab09..9640f72 100644 (file)
@@ -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
 
index b29d707..eea525c 100644 (file)
@@ -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)
index 858797f..cedc048 100644 (file)
@@ -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{..}