{-# LANGUAGE CPP #-}
module Distribution.Cab.PkgDB (
PkgDB
, PkgInfo
, getPkgDB
, getGlobalPkgDB
, getUserPkgDB
, lookupByName
, lookupByVersion
, topSortedPkgs
, toPkgInfos
, nameOfPkgInfo
, fullNameOfPkgInfo
, pairNameOfPkgInfo
, verOfPkgInfo
, findInternalLibs
) where
import Distribution.Cab.Utils
(fromDotted, installedUnitId, mkPackageName, unPackageName)
import Distribution.Cab.Version
import Distribution.Cab.VerDB (PkgName)
import Distribution.InstalledPackageInfo
(InstalledPackageInfo(depends), sourcePackageId)
import Distribution.Package (PackageIdentifier(..))
import Distribution.Simple.Compiler (PackageDB(..))
import Distribution.Simple.GHC (configure, getInstalledPackages, getPackageDBContents)
import Distribution.Simple.PackageIndex
(lookupPackageName, lookupSourcePackageId, allPackages
, fromList, reverseDependencyClosure, topologicalOrder)
#if MIN_VERSION_Cabal(1,22,0)
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
#else
import Distribution.Simple.PackageIndex (PackageIndex)
#endif
import Distribution.Simple.Program.Db (defaultProgramDb)
import Distribution.Verbosity (normal)
import Distribution.Types.UnitId (unUnitId)
import Data.Char
import Data.Maybe
#if MIN_VERSION_Cabal(1,22,0)
type PkgDB = InstalledPackageIndex
#else
type PkgDB = PackageIndex
#endif
type PkgInfo = InstalledPackageInfo
getPkgDB :: Maybe FilePath -> IO PkgDB
getPkgDB :: Maybe FilePath -> IO PkgDB
getPkgDB Maybe FilePath
mpath = [PackageDB] -> IO PkgDB
getDBs [PackageDB
GlobalPackageDB,PackageDB
userDB]
where
userDB :: PackageDB
userDB = Maybe FilePath -> PackageDB
toUserSpec Maybe FilePath
mpath
getUserPkgDB :: Maybe FilePath -> IO PkgDB
getUserPkgDB :: Maybe FilePath -> IO PkgDB
getUserPkgDB Maybe FilePath
mpath = PackageDB -> IO PkgDB
getDB PackageDB
userDB
where
userDB :: PackageDB
userDB = Maybe FilePath -> PackageDB
toUserSpec Maybe FilePath
mpath
getGlobalPkgDB :: IO PkgDB
getGlobalPkgDB :: IO PkgDB
getGlobalPkgDB = PackageDB -> IO PkgDB
getDB PackageDB
GlobalPackageDB
toUserSpec :: Maybe FilePath -> PackageDB
toUserSpec :: Maybe FilePath -> PackageDB
toUserSpec Maybe FilePath
Nothing = PackageDB
UserPackageDB
toUserSpec (Just FilePath
path) = FilePath -> PackageDB
SpecificPackageDB FilePath
path
getDBs :: [PackageDB] -> IO PkgDB
getDBs :: [PackageDB] -> IO PkgDB
getDBs [PackageDB]
specs = do
(Compiler
_comp,Maybe Platform
_,ProgramDb
pro) <- Verbosity
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
normal forall a. Maybe a
Nothing forall a. Maybe a
Nothing ProgramDb
defaultProgramDb
Verbosity -> Compiler -> [PackageDB] -> ProgramDb -> IO PkgDB
getInstalledPackages Verbosity
normal
#if MIN_VERSION_Cabal(1,23,0)
Compiler
_comp
#endif
[PackageDB]
specs ProgramDb
pro
getDB :: PackageDB -> IO PkgDB
getDB :: PackageDB -> IO PkgDB
getDB PackageDB
spec = do
(Compiler
_,Maybe Platform
_,ProgramDb
pro) <- Verbosity
-> Maybe FilePath
-> Maybe FilePath
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
configure Verbosity
normal forall a. Maybe a
Nothing forall a. Maybe a
Nothing ProgramDb
defaultProgramDb
Verbosity -> PackageDB -> ProgramDb -> IO PkgDB
getPackageDBContents Verbosity
normal PackageDB
spec ProgramDb
pro
lookupByName :: PkgName -> PkgDB -> [PkgInfo]
lookupByName :: FilePath -> PkgDB -> [PkgInfo]
lookupByName FilePath
name PkgDB
db = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. PackageIndex a -> PackageName -> [(Version, [a])]
lookupPackageName PkgDB
db (FilePath -> PackageName
mkPackageName FilePath
name)
lookupByVersion :: PkgName -> String -> PkgDB -> [PkgInfo]
lookupByVersion :: FilePath -> FilePath -> PkgDB -> [PkgInfo]
lookupByVersion FilePath
name FilePath
ver PkgDB
db = forall a. PackageIndex a -> PackageId -> [a]
lookupSourcePackageId PkgDB
db PackageId
src
where
src :: PackageId
src = PackageIdentifier {
pkgName :: PackageName
pkgName = FilePath -> PackageName
mkPackageName FilePath
name
, pkgVersion :: Version
pkgVersion = [Int] -> Version
toVersion forall a b. (a -> b) -> a -> b
$ FilePath -> [Int]
fromDotted FilePath
ver
}
toPkgInfos :: PkgDB -> [PkgInfo]
toPkgInfos :: PkgDB -> [PkgInfo]
toPkgInfos PkgDB
db = forall a. PackageIndex a -> [a]
allPackages PkgDB
db
nameOfPkgInfo :: PkgInfo -> PkgName
nameOfPkgInfo :: PkgInfo -> FilePath
nameOfPkgInfo = PackageName -> FilePath
unPackageName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> PackageName
pkgName forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> PackageId
sourcePackageId
fullNameOfPkgInfo :: PkgInfo -> String
fullNameOfPkgInfo :: PkgInfo -> FilePath
fullNameOfPkgInfo PkgInfo
pkgi = PkgInfo -> FilePath
nameOfPkgInfo PkgInfo
pkgi forall a. [a] -> [a] -> [a]
++ FilePath
" " forall a. [a] -> [a] -> [a]
++ Ver -> FilePath
verToString (PkgInfo -> Ver
verOfPkgInfo PkgInfo
pkgi)
pairNameOfPkgInfo :: PkgInfo -> (PkgName,String)
pairNameOfPkgInfo :: PkgInfo -> (FilePath, FilePath)
pairNameOfPkgInfo PkgInfo
pkgi = (PkgInfo -> FilePath
nameOfPkgInfo PkgInfo
pkgi, Ver -> FilePath
verToString (PkgInfo -> Ver
verOfPkgInfo PkgInfo
pkgi))
verOfPkgInfo :: PkgInfo -> Ver
verOfPkgInfo :: PkgInfo -> Ver
verOfPkgInfo = Version -> Ver
version forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> Version
pkgVersion forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgInfo -> PackageId
sourcePackageId
topSortedPkgs :: PkgInfo -> PkgDB -> [PkgInfo]
topSortedPkgs :: PkgInfo -> PkgDB -> [PkgInfo]
topSortedPkgs PkgInfo
pkgi PkgDB
db = [UnitId] -> [PkgInfo]
topSort forall a b. (a -> b) -> a -> b
$ [PkgInfo] -> [UnitId]
unitids [PkgInfo
pkgi]
where
unitids :: [PkgInfo] -> [UnitId]
unitids = forall a b. (a -> b) -> [a] -> [b]
map PkgInfo -> UnitId
installedUnitId
topSort :: [UnitId] -> [PkgInfo]
topSort = forall a. PackageInstalled a => PackageIndex a -> [a]
topologicalOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PkgInfo] -> PkgDB
fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PackageInstalled a => PackageIndex a -> [UnitId] -> [a]
reverseDependencyClosure PkgDB
db
findInternalLibs :: PkgInfo -> [String]
findInternalLibs :: PkgInfo -> [FilePath]
findInternalLibs PkgInfo
pkgInfo =
forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Maybe FilePath
getInternalLib forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnitId -> FilePath
unUnitId) forall a b. (a -> b) -> a -> b
$ PkgInfo -> [UnitId]
depends PkgInfo
pkgInfo
getInternalLib :: String -> Maybe String
getInternalLib :: FilePath -> Maybe FilePath
getInternalLib FilePath
xs0 = case forall a. Int -> [a] -> [a]
drop Int
22 forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
skip FilePath
xs0 of
Char
_:FilePath
xs1 -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
take (forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
xs1) FilePath
xs1
FilePath
_ -> forall a. Maybe a
Nothing
where
skip :: FilePath -> FilePath
skip FilePath
ys = case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'-') FilePath
ys of
(FilePath
_,Char
'-':Char
b:FilePath
bs)
| Char -> Bool
isDigit Char
b -> case forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'-') FilePath
bs of
(FilePath
_,Char
'-':FilePath
ds) -> FilePath
ds
(FilePath, FilePath)
_ -> FilePath
""
| Bool
otherwise -> FilePath -> FilePath
skip FilePath
bs
(FilePath, FilePath)
_ -> FilePath
""