{-# LANGUAGE RecordWildCards #-} module Distribution.Server.Features.Distro.Distributions ( DistroName(..) , Distributions(..) , emptyDistributions , addDistro , removeDistro , updatePackageList , enumerate , isDistribution , DistroVersions(..) , emptyDistroVersions , DistroPackageInfo(..) , addPackage , dropPackage , removeDistroVersions , distroStatus , packageStatus , distroPackageStatus , getDistroMaintainers , modifyDistroMaintainers ) where import qualified Data.Map as Map import qualified Data.Set as Set import Distribution.Server.Features.Distro.Types import qualified Distribution.Server.Users.Group as Group import Distribution.Server.Users.Group (UserList) import Distribution.Package import Data.List (foldl') import Data.Maybe (fromJust, fromMaybe) emptyDistributions :: Distributions emptyDistributions = Distributions Map.empty emptyDistroVersions :: DistroVersions emptyDistroVersions = DistroVersions Map.empty Map.empty --- Distribution updating isDistribution :: DistroName -> Distributions -> Bool isDistribution distro distros = Map.member distro (nameMap distros) -- | Add a distribution. Returns 'Nothing' if the -- name is already in use. addDistro :: DistroName -> Distributions -> Maybe Distributions addDistro name distros | isDistribution name distros = Nothing | otherwise = Just . Distributions $ Map.insert name Group.empty (nameMap distros) -- | List all known distributions enumerate :: Distributions -> [DistroName] enumerate distros = Map.keys (nameMap distros) --- Queries -- | For a particular distribution, which packages do they have, and -- at which version. This function isn't very total. distroStatus :: DistroName -> DistroVersions -> [(PackageName, DistroPackageInfo)] distroStatus distro distros = let packageNames = maybe [] Set.toList (Map.lookup distro $ distroMap distros) f package = let infoMap = fromJust $ Map.lookup package (packageDistroMap distros) info = fromJust $ Map.lookup distro infoMap in (package, info) in map f packageNames -- | For a particular package, which distributions contain it and at which -- version. packageStatus :: PackageName -> DistroVersions -> [(DistroName, DistroPackageInfo)] packageStatus package dv = maybe [] Map.toList (Map.lookup package $ packageDistroMap dv) distroPackageStatus :: DistroName -> PackageName -> DistroVersions -> Maybe DistroPackageInfo distroPackageStatus distro package dv = Map.lookup distro =<< Map.lookup package (packageDistroMap dv) --- Removing -- | Remove a distirbution from the list of known distirbutions removeDistro :: DistroName -> Distributions -> Distributions removeDistro distro distros = distros { nameMap = Map.delete distro (nameMap distros) } -- | Drop all packages for a distribution. removeDistroVersions :: DistroName -> DistroVersions -> DistroVersions removeDistroVersions distro dv = let packageNames = maybe [] Set.toList (Map.lookup distro $ distroMap dv) in foldl' (flip $ dropPackage distro) dv packageNames --- Updating -- | Bulk update of all information for one specific distribution updatePackageList :: DistroName -> [(PackageName, DistroPackageInfo)] -> DistroVersions -> DistroVersions updatePackageList distro list dv = foldr (\(pn,dpi) -> addPackage distro pn dpi) (removeDistroVersions distro dv) list -- | Flag a package as no longer being distributed dropPackage :: DistroName -> PackageName -> DistroVersions -> DistroVersions dropPackage distro package dv@DistroVersions{..} = dv { packageDistroMap = Map.update pUpdate package packageDistroMap , distroMap = Map.update dUpdate distro distroMap } where pUpdate infoMap = case Map.delete distro infoMap of infoMap' -> if Map.null infoMap' then Nothing else Just infoMap' dUpdate packageNames = case Set.delete package packageNames of packageNames' -> if Set.null packageNames' then Nothing else Just packageNames' -- | Add a package for a distribution. If the distribution already -- had information for the specified package, that information is replaced. addPackage :: DistroName -> PackageName -> DistroPackageInfo -> DistroVersions -> DistroVersions addPackage distro package info dv@DistroVersions{..} = dv { packageDistroMap = Map.insertWith' (const $ Map.insert distro info) package (Map.singleton distro info) packageDistroMap , distroMap = Map.insertWith -- should be insertWith'? (const $ Set.insert package) distro (Set.singleton package) distroMap } getDistroMaintainers :: DistroName -> Distributions -> Maybe UserList getDistroMaintainers name = Map.lookup name . nameMap modifyDistroMaintainers :: DistroName -> (UserList -> UserList) -> Distributions -> Distributions modifyDistroMaintainers name func dists = dists {nameMap = Map.alter (Just . func . fromMaybe Group.empty) name (nameMap dists) }