import qualified System.Info(os)
#endif
-#if __GLASGOW_HASKELL__ >= 611
+#if !defined(mingw32_HOST_OS) && __GLASGOW_HASKELL__ >= 611 && !defined(BOOTSTRAPPING)
import System.Console.Terminfo as Terminfo
#endif
usageHeader :: String -> String
usageHeader prog = substProg prog $
"Usage:\n" ++
+ " $p init {path}\n" ++
+ " Create and initialise a package database at the location {path}.\n" ++
+ " Packages can be registered in the new database using the register\n" ++
+ " command with --package-conf={path}. To use the new database with GHC,\n" ++
+ " use GHC's -package-conf flag.\n" ++
+ "\n" ++
" $p register {filename | -}\n" ++
" Register the package using the specified installed package\n" ++
" description. The syntax for the latter is given in the $p\n" ++
- " documentation.\n" ++
+ " documentation. The input file should be encoded in UTF-8.\n" ++
"\n" ++
" $p update {filename | -}\n" ++
" Register the package, overwriting any other package with the\n" ++
- " same name.\n" ++
+ " same name. The input file should be encoded in UTF-8.\n" ++
"\n" ++
" $p unregister {pkg-id}\n" ++
" Unregister the specified package.\n" ++
" $p dump\n" ++
" Dump the registered description for every package. This is like\n" ++
" \"ghc-pkg describe '*'\", except that it is intended to be used\n" ++
- " by tools that parse the results, rather than humans.\n" ++
+ " by tools that parse the results, rather than humans. The output is\n" ++
+ " always encoded in UTF-8, regardless of the current locale.\n" ++
+ "\n" ++
+ " $p recache\n" ++
+ " Regenerate the package database cache. This command should only be\n" ++
+ " necessary if you added a package to the database by dropping a file\n" ++
+ " into the database directory manually. By default, the global DB\n" ++
+ " is recached; to recache a different DB use --user or --package-conf\n" ++
+ " as appropriate.\n" ++
"\n" ++
" Substring matching is supported for {module} in find-module and\n" ++
" for {pkg} in list, describe, and field, where a '*' indicates\n" ++
print filename
glob filename >>= print
#endif
+ ["init", filename] ->
+ initPackageDB filename verbosity cli
["register", filename] ->
registerPackage filename verbosity cli auto_ghci_libs False force
["update", filename] ->
parseMultiPackageConf :: Verbosity -> FilePath -> IO [InstalledPackageInfo]
parseMultiPackageConf verbosity file = do
when (verbosity > Normal) $ putStrLn ("reading package database: " ++ file)
- str <- readFile file
+ str <- readUTF8File file
let pkgs = map convertPackageInfoIn $ read str
Exception.evaluate pkgs
`catchError` \e->
parseSingletonPackageConf :: Verbosity -> FilePath -> IO InstalledPackageInfo
parseSingletonPackageConf verbosity file = do
when (verbosity > Normal) $ putStrLn ("reading package config: " ++ file)
- readFile file >>= parsePackageInfo
+ 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 = [] }
+
+-- -----------------------------------------------------------------------------
-- Registering
registerPackage :: FilePath
"-" -> do
when (verbosity >= Normal) $
putStr "Reading package info from stdin ... "
+#if __GLASGOW_HASKELL__ >= 612
+ -- fix the encoding to UTF-8, since this is an interchange format
+ hSetEncoding stdin utf8
+#endif
getContents
f -> do
when (verbosity >= Normal) $
putStr ("Reading package info from " ++ show f ++ " ... ")
- readFile f
+ readUTF8File f
expanded <- expandEnvVars s force
if simple_output then show_simple stack else do
-#if __GLASGOW_HASKELL__ < 611
+#if defined(mingw32_HOST_OS) || __GLASGOW_HASKELL__ < 611 || defined(BOOTSTRAPPING)
mapM_ show_normal stack
#else
let
getPkgDatabases verbosity False True{-use cache-} myflags
let all_pkgs = allPackagesInStack flag_db_stack
- ipix = PackageIndex.listToInstalledPackageIndex all_pkgs
+ ipix = PackageIndex.fromList all_pkgs
putStrLn "digraph {"
let quote s = '"':s ++ "\""
| p <- all_pkgs,
let from = display (sourcePackageId p),
depid <- depends p,
- Just dep <- [PackageIndex.lookupInstalledPackage ipix depid],
+ Just dep <- [PackageIndex.lookupInstalledPackageId ipix depid],
let to = display (sourcePackageId dep)
]
putStrLn "}"
doDump (allPackagesInStack flag_db_stack)
doDump :: [InstalledPackageInfo] -> IO ()
-doDump = mapM_ putStrLn . intersperse "---" . map showInstalledPackageInfo
+doDump pkgs = do
+#if __GLASGOW_HASKELL__ >= 612
+ -- fix the encoding to UTF-8, since this is an interchange format
+ hSetEncoding stdout utf8
+#endif
+ mapM_ putStrLn . intersperse "---" . map showInstalledPackageInfo $ pkgs
-- PackageId is can have globVersion for the version
findPackages :: PackageDBStack -> PackageArg -> IO [InstalledPackageInfo]
_ -> chunk'
(chunk', rest') = break isSearchPathSeparator s
+
+readUTF8File :: FilePath -> IO String
+readUTF8File file = do
+ h <- openFile file ReadMode
+#if __GLASGOW_HASKELL__ >= 612
+ -- fix the encoding to UTF-8
+ hSetEncoding h utf8
+#endif
+ hGetContents h
projects / ghc-hetmet.git / blobdiff