{-# LANGUAGE CPP #-}
module Distribution.Cab.PkgDB (
  -- * Types
    PkgDB
  , PkgInfo
  -- * Obtaining 'PkgDB'
  , getPkgDB
  , getGlobalPkgDB
  , getUserPkgDB
  -- * Looking up
  , lookupByName
  , lookupByVersion
  -- * Topological sorting
  , topSortedPkgs
  -- * To 'PkgInfo'
  , toPkgInfos
  -- * From 'PkgInfo'
  , nameOfPkgInfo
  , fullNameOfPkgInfo
  , pairNameOfPkgInfo
  , verOfPkgInfo
  ) where

import Distribution.Cab.Utils
    (fromDotted, installedUnitId, mkPackageName, unPackageName)
import Distribution.Cab.Version
import Distribution.Cab.VerDB (PkgName)
import Distribution.InstalledPackageInfo
    (InstalledPackageInfo, 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)

#if MIN_VERSION_Cabal(1,22,0)
type PkgDB = InstalledPackageIndex
#else
type PkgDB = PackageIndex
#endif
type PkgInfo = InstalledPackageInfo

----------------------------------------------------------------

-- | Obtaining 'PkgDB' for global and user
--
-- > getSandbox >>= getPkgDB
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

-- | Obtaining 'PkgDB' for user
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

-- | Obtaining 'PkgDB' for global
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

----------------------------------------------------------------

-- |
--
-- > pkgdb <- getGlobalPkgDB
-- > lookupByName "base" pkgdb
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)

-- |
--
-- > pkgdb <- getGlobalPkgDB
-- > lookupByVersion "base" "4.6.0.1" pkgdb
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