|
sourcecode:
|
module CPM.LookupSet
( LookupSource (..)
, LookupSet
, emptySet
, addPackage
, findLatestVersion
, findAllVersions
, findVersion
, addPackages
, allPackages
, lookupSource
, setLocallyIgnored
) where
import Data.List (sortBy, delete, deleteBy)
import Test.Prop
import Prelude hiding (empty)
import Data.Table.RBTree as Table ( TableRBT, empty, lookup, toList,update )
import CPM.Package
------------------------------------------------------------------------------
data LookupSource = FromRepository
| FromLocalCache
| FromGlobalCache
type PkgMap = TableRBT String [(LookupSource, Package)]
data LookupSet = LookupSet PkgMap LookupOptions
data LookupOptions = LookupOptions
{ ignoreLocalVersions :: [String] }
--- The empty lookup set.
emptySet :: LookupSet
emptySet = LookupSet (empty (<=)) defaultOptions
defaultOptions :: LookupOptions
defaultOptions = LookupOptions []
--- Set the set of packages whose locally installed versions are ignored when
--- finding all package versions.
setLocallyIgnored :: LookupSet -> [String] -> LookupSet
setLocallyIgnored (LookupSet ls o) pkgs =
LookupSet ls (o { ignoreLocalVersions = pkgs })
--- Adds multiple packages to a lookup set with the same source.
---
--- @param l the set to add to
--- @param p the packages to add
--- @param s where are the package specs from?
addPackages :: LookupSet -> [Package] -> LookupSource -> LookupSet
addPackages ls pkgs src = foldl (\l p -> addPackage l p src) ls pkgs
allPackages :: LookupSet -> [Package]
allPackages (LookupSet ls _) = map snd $ concat $ map snd $ toList ls
--- Adds a package to a lookup set.
---
--- @param l the set to add to
--- @param p the package to add
--- @param s where is the package spec from?
addPackage :: LookupSet -> Package -> LookupSource -> LookupSet
addPackage (LookupSet ls o) pkg src = case Table.lookup (name pkg) ls of
Nothing -> LookupSet (update (name pkg) [(src, pkg)] ls) o
Just ps -> let ps' = filter ((/= packageId pkg) . packageId . snd) ps
in LookupSet (update (name pkg) ((src, pkg):ps') ls) o
--- Finds a specific entry (including the source) in the lookup set.
---
--- @param l the lookup set
--- @param p the package to search for
findEntry :: LookupSet -> Package -> Maybe (LookupSource, Package)
findEntry (LookupSet ls _) p = maybeHead candidates
where
allVersions = Table.lookup (name p) ls
candidates = case allVersions of
Nothing -> []
Just ps -> filter ((packageIdEq p) . snd) ps
--- Finds all versions of a package known to the lookup set. Returns the
--- packages from the local cache first, and then from other sources. Each
--- group is sorted from newest do oldest version.
---
--- @param l the lookup set
--- @param p the name of the package to search for
--- @param pre should pre-release versions be included?
findAllVersions :: LookupSet -> String -> Bool -> [Package]
findAllVersions (LookupSet ls o) p pre = localSorted' ++ nonLocalSorted
where
packageVersions = case Table.lookup p ls of
Nothing -> []
Just vs -> vs
onlyLocal = filter isLocal packageVersions
onlyNonLocal = filter (not . isLocal) packageVersions
localSorted = sortedByVersion $ preFiltered $ sameName $ ps $ onlyLocal
localSorted' = filter (not . (flip elem) (ignoreLocalVersions o) . name) localSorted
nonLocalSorted = sortedByVersion $ preFiltered $ sameName $ ps $ onlyNonLocal
sortedByVersion = sortBy (\a b -> (version a) `vgt` (version b))
preFiltered = filter filterPre
sameName = filter ((== p) . name)
filterPre p' = pre || (not . isPreRelease . version) p'
isLocal (FromLocalCache, _) = True
isLocal (FromGlobalCache, _) = False
isLocal (FromRepository, _) = False
ps = map snd
test_findAllVersions_localBeforeNonLocal :: Prop
test_findAllVersions_localBeforeNonLocal = findAllVersions ls "A" False -=- [aLocal, aNonLocal]
where aLocal = cPackage "A" (1, 0, 0, Nothing) []
aNonLocal = cPackage "A" (1, 1, 0, Nothing) []
ls = addPackage (addPackage emptySet aLocal FromLocalCache) aNonLocal FromRepository
test_findAllVersions_nonLocalIfIgnored :: Prop
test_findAllVersions_nonLocalIfIgnored = findAllVersions ls "A" False -=- [aNonLocal]
where aLocal = cPackage "A" (1, 0, 0, Nothing) []
aNonLocal = cPackage "A" (1, 1, 0, Nothing) []
ls = setLocallyIgnored (addPackage (addPackage emptySet aLocal FromLocalCache) aNonLocal FromRepository) ["A"]
cPackage :: String -> Version -> [Dependency] -> Package
cPackage p v ds = emptyPackage {
name = p
, version = v
, author = ["author"]
, synopsis = "JSON library for Curry"
, dependencies = ds
, maintainer = []
, description = Nothing
, license = Nothing
, licenseFile = Nothing
, copyright = Nothing
, homepage = Nothing
, bugReports = Nothing
, repository = Nothing
, compilerCompatibility = []
, source = Nothing
, exportedModules = []
}
cDB :: [Package] -> LookupSet
cDB ps = addPackages emptySet ps FromRepository
--- Finds the source for a package in the lookup set
---
--- @param ls the lookup set
--- @param p the package to search for
lookupSource :: LookupSet -> Package -> Maybe LookupSource
lookupSource ls p = case findEntry ls p of
Nothing -> Nothing
Just (s, _) -> Just s
--- Finds the latest version of a package known to the lookup set.
---
--- @param l the lookup set
--- @param p the name of the package to search for
--- @param pre should pre-release versions be included?
findLatestVersion :: LookupSet -> String -> Bool -> Maybe Package
findLatestVersion ls p pre = case findAllVersions ls p pre of
[] -> Nothing
(x:_) -> Just x
--- Finds a specific version of a package in the lookup set.
---
--- @param l the lookup set
--- @param p the name of the package
--- @param v the package version
findVersion :: LookupSet -> String -> Version -> Maybe Package
findVersion ls p v =
maybeHead $ filter ((== v) . version) $ findAllVersions ls p True
maybeHead :: [a] -> Maybe a
maybeHead [] = Nothing
maybeHead (x:_) = Just x
|