+ = do e <- tryIO $ getDirectoryContents path
+ case e of
+ Left _ -> do
+ pkgs <- parseMultiPackageConf verbosity path
+ return PackageDB{ location = path, packages = pkgs }
+ Right fs
+ | not use_cache -> ignore_cache
+ | otherwise -> do
+ let cache = path </> cachefilename
+ tdir <- getModificationTime path
+ e_tcache <- tryIO $ getModificationTime cache
+ case e_tcache of
+ Left ex -> do
+ when (verbosity > Normal) $
+ warn ("warning: cannot read cache file " ++ cache ++ ": " ++ show ex)
+ ignore_cache
+ Right tcache
+ | tcache >= tdir -> do
+ when (verbosity > Normal) $
+ putStrLn ("using cache: " ++ cache)
+ pkgs <- myReadBinPackageDB cache
+ let pkgs' = map convertPackageInfoIn pkgs
+ return PackageDB { location = path, packages = pkgs' }
+ | otherwise -> do
+ when (verbosity >= Normal) $ do
+ warn ("WARNING: cache is out of date: " ++ cache)
+ warn " use 'ghc-pkg recache' to fix."
+ ignore_cache
+ where
+ ignore_cache = do
+ let confs = filter (".conf" `isSuffixOf`) fs
+ pkgs <- mapM (parseSingletonPackageConf verbosity) $
+ map (path </>) confs
+ return PackageDB { location = path, packages = pkgs }
+
+-- read the package.cache file strictly, to work around a problem with
+-- bytestring 0.9.0.x (fixed in 0.9.1.x) where the file wasn't closed
+-- after it has been completely read, leading to a sharing violation
+-- later.
+myReadBinPackageDB :: FilePath -> IO [InstalledPackageInfoString]
+myReadBinPackageDB filepath = do
+ h <- openBinaryFile filepath ReadMode
+ sz <- hFileSize h
+ b <- B.hGet h (fromIntegral sz)
+ hClose h
+ return $ Bin.runGet Bin.get b
+
+parseMultiPackageConf :: Verbosity -> FilePath -> IO [InstalledPackageInfo]
+parseMultiPackageConf verbosity file = do
+ when (verbosity > Normal) $ putStrLn ("reading package database: " ++ file)
+ str <- readUTF8File file
+ let pkgs = map convertPackageInfoIn $ read str
+ Exception.evaluate pkgs
+ `catchError` \e->
+ die ("error while parsing " ++ file ++ ": " ++ show e)
+
+parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
+parseSingletonPackageConf verbosity file = do
+ when (verbosity > Normal) $ putStrLn ("reading package config: " ++ file)
+ readUTF8File file >>= parsePackageInfo
+
+cachefilename :: FilePath
+cachefilename = "package.cache"
+
+-- -----------------------------------------------------------------------------
+-- Creating a new package DB
+
+initPackageDB :: FilePath -> Verbosity -> [Flag] -> IO ()
+initPackageDB filename verbosity _flags = do
+ let eexist = die ("cannot create: " ++ filename ++ " already exists")
+ b1 <- doesFileExist filename
+ when b1 eexist
+ b2 <- doesDirectoryExist filename
+ when b2 eexist
+ changeDB verbosity [] PackageDB{ location = filename, packages = [] }