{-# 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
  -- * Find internal libraries
  , 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

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

-- | 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

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

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
"" -- error
        | Bool
otherwise -> FilePath -> FilePath
skip FilePath
bs
      (FilePath, FilePath)
_  -> FilePath
"" -- error