{-# LANGUAGE ScopedTypeVariables #-}
-- |Functions for dealing with source and binary packages in an abstract-way
module Debian.Apt.Package where

-- Standard GHC Modules

import qualified Data.Map as Map

-- Local Modules

import Debian.Version
import Debian.Relation

type PackageNameMap a = Map.Map BinPkgName [a]

-- |'packageNameMap' creates a map from a package name to all the versions of that package
-- NOTE: Provides are not included in the map
-- NOTE: the sort order is random -- this is perhaps a bug
-- see also: 'addProvides'
packageNameMap :: (a -> BinPkgName) -> [a] -> PackageNameMap a
packageNameMap :: (a -> BinPkgName) -> [a] -> PackageNameMap a
packageNameMap a -> BinPkgName
getName [a]
packages = (PackageNameMap a -> a -> PackageNameMap a)
-> PackageNameMap a -> [a] -> PackageNameMap a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PackageNameMap a
m a
p -> ([a] -> [a] -> [a])
-> BinPkgName -> [a] -> PackageNameMap a -> PackageNameMap a
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
(++) (a -> BinPkgName
getName a
p) [a
p] PackageNameMap a
m) PackageNameMap a
forall k a. Map k a
Map.empty [a]
packages

-- |'addProvides' finds packages that Provide other packages and adds
-- them to the PackageNameMap. They will be adde to the end of the
-- list, so that real packages have 'higher priority' than virtual
-- packages.
-- NOTE: Does not check for duplication or multiple use
addProvides :: (p -> [BinPkgName]) -> [p] -> PackageNameMap p -> PackageNameMap p
addProvides :: (p -> [BinPkgName]) -> [p] -> PackageNameMap p -> PackageNameMap p
addProvides p -> [BinPkgName]
providesf [p]
ps PackageNameMap p
pnm =
    let provides :: [(BinPkgName, p)]
provides = (p -> [BinPkgName]) -> [p] -> [(BinPkgName, p)]
forall p. (p -> [BinPkgName]) -> [p] -> [(BinPkgName, p)]
findProvides p -> [BinPkgName]
providesf [p]
ps in
    (PackageNameMap p -> (BinPkgName, p) -> PackageNameMap p)
-> PackageNameMap p -> [(BinPkgName, p)] -> PackageNameMap p
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\PackageNameMap p
m (BinPkgName
packageName, p
package) -> ([p] -> [p] -> [p])
-> BinPkgName -> [p] -> PackageNameMap p -> PackageNameMap p
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (([p] -> [p] -> [p]) -> [p] -> [p] -> [p]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [p] -> [p] -> [p]
forall a. [a] -> [a] -> [a]
(++)) BinPkgName
packageName [p
package] PackageNameMap p
m) PackageNameMap p
pnm [(BinPkgName, p)]
provides

-- |'findProvides'
findProvides :: forall p. (p -> [BinPkgName]) -> [p] -> [(BinPkgName, p)]
findProvides :: (p -> [BinPkgName]) -> [p] -> [(BinPkgName, p)]
findProvides p -> [BinPkgName]
providesf [p]
packages = ([(BinPkgName, p)] -> p -> [(BinPkgName, p)])
-> [(BinPkgName, p)] -> [p] -> [(BinPkgName, p)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [(BinPkgName, p)] -> p -> [(BinPkgName, p)]
addProvides' [] [p]
packages
    where addProvides' :: [(BinPkgName, p)] -> p -> [(BinPkgName, p)]
          addProvides' :: [(BinPkgName, p)] -> p -> [(BinPkgName, p)]
addProvides' [(BinPkgName, p)]
providesList p
package =
              ([(BinPkgName, p)] -> BinPkgName -> [(BinPkgName, p)])
-> [(BinPkgName, p)] -> [BinPkgName] -> [(BinPkgName, p)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\[(BinPkgName, p)]
pl BinPkgName
pkgName -> (BinPkgName
pkgName, p
package)(BinPkgName, p) -> [(BinPkgName, p)] -> [(BinPkgName, p)]
forall a. a -> [a] -> [a]
: [(BinPkgName, p)]
pl) [(BinPkgName, p)]
providesList (p -> [BinPkgName]
providesf p
package)

-- |'lookupPackageByRel' returns all the packages that satisfy the specified relation
-- TODO: Add architecture check
lookupPackageByRel :: PackageNameMap a -> (a -> (BinPkgName, DebianVersion)) -> Relation -> [a]
lookupPackageByRel :: PackageNameMap a
-> (a -> (BinPkgName, DebianVersion)) -> Relation -> [a]
lookupPackageByRel PackageNameMap a
pm a -> (BinPkgName, DebianVersion)
packageVersionF (Rel BinPkgName
pkgName Maybe VersionReq
mVerReq Maybe ArchitectureReq
_mArch) =
    case BinPkgName -> PackageNameMap a -> Maybe [a]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup BinPkgName
pkgName PackageNameMap a
pm of
      Maybe [a]
Nothing -> []
      Just [a]
packages -> (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
filter a -> Bool
filterVer [a]
packages
    where filterVer :: a -> Bool
filterVer a
p =
              case Maybe VersionReq
mVerReq of
                Maybe VersionReq
Nothing -> Bool
True
                Just VersionReq
_verReq ->
                    let (BinPkgName
pName, DebianVersion
pVersion) = a -> (BinPkgName, DebianVersion)
packageVersionF a
p
                    in if BinPkgName
pName BinPkgName -> BinPkgName -> Bool
forall a. Eq a => a -> a -> Bool
/= BinPkgName
pkgName
                       then Bool
False -- package is a virtual package, hence we can not do a version req
                       else Maybe VersionReq -> Maybe DebianVersion -> Bool
checkVersionReq Maybe VersionReq
mVerReq (DebianVersion -> Maybe DebianVersion
forall a. a -> Maybe a
Just DebianVersion
pVersion)