{-# LANGUAGE DeriveGeneric #-}
module Distribution.Client.Types.SourcePackageDb (
    SourcePackageDb (..),
    lookupDependency,
    lookupPackageName,
) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Types.PackageName  (PackageName)
import Distribution.Types.VersionRange (VersionRange, withinRange)
import Distribution.Package            (packageVersion)

import Distribution.Client.Types.PackageLocation (UnresolvedSourcePackage)
import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
import Distribution.Solver.Types.PackageIndex    (PackageIndex)

import qualified Data.Map as Map

-- | This is the information we get from a @00-index.tar.gz@ hackage index.
--
data SourcePackageDb = SourcePackageDb
    { SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex       :: PackageIndex UnresolvedSourcePackage
    , SourcePackageDb -> Map PackageName VersionRange
packagePreferences :: Map PackageName VersionRange
    }
  deriving (SourcePackageDb -> SourcePackageDb -> Bool
(SourcePackageDb -> SourcePackageDb -> Bool)
-> (SourcePackageDb -> SourcePackageDb -> Bool)
-> Eq SourcePackageDb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourcePackageDb -> SourcePackageDb -> Bool
$c/= :: SourcePackageDb -> SourcePackageDb -> Bool
== :: SourcePackageDb -> SourcePackageDb -> Bool
$c== :: SourcePackageDb -> SourcePackageDb -> Bool
Eq, (forall x. SourcePackageDb -> Rep SourcePackageDb x)
-> (forall x. Rep SourcePackageDb x -> SourcePackageDb)
-> Generic SourcePackageDb
forall x. Rep SourcePackageDb x -> SourcePackageDb
forall x. SourcePackageDb -> Rep SourcePackageDb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SourcePackageDb x -> SourcePackageDb
$cfrom :: forall x. SourcePackageDb -> Rep SourcePackageDb x
Generic)

instance Binary SourcePackageDb

-- | Does a case-sensitive search by package name and a range of versions.
--
-- We get back any number of versions of the specified package name, all
-- satisfying the version range constraint.
--
-- Additionally, `preferred-versions` (such as version deprecation) are
-- honoured in this lookup, which is the only difference to
-- 'PackageIndex.lookupDependency'
lookupDependency :: SourcePackageDb -> PackageName -> VersionRange -> [UnresolvedSourcePackage]
lookupDependency :: SourcePackageDb
-> PackageName -> VersionRange -> [UnresolvedSourcePackage]
lookupDependency SourcePackageDb
sourceDb PackageName
pname VersionRange
version =
  Maybe VersionRange
-> [UnresolvedSourcePackage] -> [UnresolvedSourcePackage]
filterPreferredVersions Maybe VersionRange
pref ([UnresolvedSourcePackage] -> [UnresolvedSourcePackage])
-> [UnresolvedSourcePackage] -> [UnresolvedSourcePackage]
forall a b. (a -> b) -> a -> b
$ PackageIndex UnresolvedSourcePackage
-> PackageName -> VersionRange -> [UnresolvedSourcePackage]
forall pkg.
Package pkg =>
PackageIndex pkg -> PackageName -> VersionRange -> [pkg]
PackageIndex.lookupDependency (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
sourceDb) PackageName
pname VersionRange
version
  where
    pref :: Maybe VersionRange
pref = PackageName -> Map PackageName VersionRange -> Maybe VersionRange
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pname (SourcePackageDb -> Map PackageName VersionRange
packagePreferences SourcePackageDb
sourceDb)


-- | Does a case-sensitive search by package name.
--
-- Additionally, `preferred-versions` (such as version deprecation) are
-- honoured in this lookup, which is the only difference to
-- 'PackageIndex.lookupPackageName'
lookupPackageName :: SourcePackageDb -> PackageName -> [UnresolvedSourcePackage]
lookupPackageName :: SourcePackageDb -> PackageName -> [UnresolvedSourcePackage]
lookupPackageName SourcePackageDb
sourceDb PackageName
pname =
  Maybe VersionRange
-> [UnresolvedSourcePackage] -> [UnresolvedSourcePackage]
filterPreferredVersions Maybe VersionRange
pref ([UnresolvedSourcePackage] -> [UnresolvedSourcePackage])
-> [UnresolvedSourcePackage] -> [UnresolvedSourcePackage]
forall a b. (a -> b) -> a -> b
$ PackageIndex UnresolvedSourcePackage
-> PackageName -> [UnresolvedSourcePackage]
forall pkg. Package pkg => PackageIndex pkg -> PackageName -> [pkg]
PackageIndex.lookupPackageName (SourcePackageDb -> PackageIndex UnresolvedSourcePackage
packageIndex SourcePackageDb
sourceDb) PackageName
pname
  where
    pref :: Maybe VersionRange
pref = PackageName -> Map PackageName VersionRange -> Maybe VersionRange
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PackageName
pname (SourcePackageDb -> Map PackageName VersionRange
packagePreferences SourcePackageDb
sourceDb)

-- | @filterPreferredVersions 'range' 'versions'@.
-- If a 'range' is given, only keep versions that satisfy the range.
-- If 'range' is 'Nothing', all versions are kept.
--
-- The 'range' is expected to be obtained from the 'SourcePackageDb.packagePreferences'.
filterPreferredVersions :: Maybe VersionRange -> [UnresolvedSourcePackage] -> [UnresolvedSourcePackage]
filterPreferredVersions :: Maybe VersionRange
-> [UnresolvedSourcePackage] -> [UnresolvedSourcePackage]
filterPreferredVersions Maybe VersionRange
Nothing [UnresolvedSourcePackage]
versions = [UnresolvedSourcePackage]
versions
filterPreferredVersions (Just VersionRange
range) [UnresolvedSourcePackage]
versions = (UnresolvedSourcePackage -> Bool)
-> [UnresolvedSourcePackage] -> [UnresolvedSourcePackage]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Version -> VersionRange -> Bool
`withinRange` VersionRange
range) (Version -> Bool)
-> (UnresolvedSourcePackage -> Version)
-> UnresolvedSourcePackage
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnresolvedSourcePackage -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion) [UnresolvedSourcePackage]
versions