{-# 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 Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
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 Maybe FilePath
forall a. Maybe a
Nothing Maybe FilePath
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 = ((Version, [PkgInfo]) -> [PkgInfo])
-> [(Version, [PkgInfo])] -> [PkgInfo]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Version, [PkgInfo]) -> [PkgInfo]
forall a b. (a, b) -> b
snd ([(Version, [PkgInfo])] -> [PkgInfo])
-> [(Version, [PkgInfo])] -> [PkgInfo]
forall a b. (a -> b) -> a -> b
$ PkgDB -> PackageName -> [(Version, [PkgInfo])]
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 = PkgDB -> PackageId -> [PkgInfo]
forall a. PackageIndex a -> PackageId -> [a]
lookupSourcePackageId PkgDB
db PackageId
src
  where
    src :: PackageId
src = PackageIdentifier :: PackageName -> Version -> PackageId
PackageIdentifier {
        pkgName :: PackageName
pkgName = FilePath -> PackageName
mkPackageName FilePath
name
      , pkgVersion :: Version
pkgVersion = [Int] -> Version
toVersion ([Int] -> Version) -> [Int] -> Version
forall a b. (a -> b) -> a -> b
$ FilePath -> [Int]
fromDotted FilePath
ver
      }

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

toPkgInfos :: PkgDB -> [PkgInfo]
toPkgInfos :: PkgDB -> [PkgInfo]
toPkgInfos PkgDB
db = PkgDB -> [PkgInfo]
forall a. PackageIndex a -> [a]
allPackages PkgDB
db

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

nameOfPkgInfo :: PkgInfo -> PkgName
nameOfPkgInfo :: PkgInfo -> FilePath
nameOfPkgInfo = PackageName -> FilePath
unPackageName (PackageName -> FilePath)
-> (PkgInfo -> PackageName) -> PkgInfo -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> PackageName
pkgName (PackageId -> PackageName)
-> (PkgInfo -> PackageId) -> PkgInfo -> PackageName
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 FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> 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 (Version -> Ver) -> (PkgInfo -> Version) -> PkgInfo -> Ver
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageId -> Version
pkgVersion (PackageId -> Version)
-> (PkgInfo -> PackageId) -> PkgInfo -> Version
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 ([UnitId] -> [PkgInfo]) -> [UnitId] -> [PkgInfo]
forall a b. (a -> b) -> a -> b
$ [PkgInfo] -> [UnitId]
unitids [PkgInfo
pkgi]
  where
    unitids :: [PkgInfo] -> [UnitId]
unitids = (PkgInfo -> UnitId) -> [PkgInfo] -> [UnitId]
forall a b. (a -> b) -> [a] -> [b]
map PkgInfo -> UnitId
installedUnitId
    topSort :: [UnitId] -> [PkgInfo]
topSort = PkgDB -> [PkgInfo]
forall a. PackageInstalled a => PackageIndex a -> [a]
topologicalOrder (PkgDB -> [PkgInfo])
-> ([UnitId] -> PkgDB) -> [UnitId] -> [PkgInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [PkgInfo] -> PkgDB
fromList ([PkgInfo] -> PkgDB)
-> ([UnitId] -> [PkgInfo]) -> [UnitId] -> PkgDB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PkgDB -> [UnitId] -> [PkgInfo]
forall a. PackageInstalled a => PackageIndex a -> [UnitId] -> [a]
reverseDependencyClosure PkgDB
db