{-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell, RecordWildCards #-} module Distribution.Server.Features.Distro.State where import Distribution.Package (PackageName) import qualified Distribution.Server.Features.Distro.Distributions as Dist import Distribution.Server.Features.Distro.Distributions (DistroName, Distributions, DistroVersions, DistroPackageInfo) import Distribution.Server.Users.Group (UserList) import qualified Distribution.Server.Users.Group as Group import Distribution.Server.Users.Types (UserId) import Distribution.Server.Users.State () import Distribution.Server.Framework.MemSize import Data.Acid (Query, Update, makeAcidic) import Data.SafeCopy (base, deriveSafeCopy) import Data.Typeable import Data.Maybe (fromMaybe) import Control.Monad (liftM) import Control.Monad.State.Class (get, put, modify) import Control.Monad.Reader.Class (ask, asks) data Distros = Distros { distDistros :: !Distributions, distVersions :: !DistroVersions } deriving (Eq, Typeable, Show) deriveSafeCopy 0 'base ''Distros instance MemSize Distros where memSize (Distros a b) = memSize2 a b initialDistros :: Distros initialDistros = Distros Dist.emptyDistributions Dist.emptyDistroVersions addDistro :: DistroName -> Update Distros Bool addDistro name = do state <- get let distros = distDistros state case Dist.addDistro name distros of Nothing -> return False Just distros' -> put state{distDistros = distros'} >> return True -- DELETES a distribution. The name may then be re-used. -- You should also clean up the permissions DB as well. removeDistro :: DistroName -> Update Distros () removeDistro distro = modify $ \state@Distros{..} -> state { distDistros = Dist.removeDistro distro distDistros , distVersions = Dist.removeDistroVersions distro distVersions } enumerateDistros :: Query Distros [DistroName] enumerateDistros = asks $ Dist.enumerate . distDistros isDistribution :: DistroName -> Query Distros Bool isDistribution distro = asks $ Dist.isDistribution distro . distDistros getDistributions :: Query Distros Distros getDistributions = ask replaceDistributions :: Distributions -> DistroVersions -> Update Distros () replaceDistributions distributions distroVersions = put $ Distros distributions distroVersions addPackage :: DistroName -> PackageName -> DistroPackageInfo -> Update Distros () addPackage distro package info = modify $ \state -> state{ distVersions = Dist.addPackage distro package info $ distVersions state } dropPackage :: DistroName -> PackageName -> Update Distros () dropPackage distro package = modify $ \state -> state{ distVersions = Dist.dropPackage distro package $ distVersions state } distroStatus :: DistroName -> Query Distros [(PackageName, DistroPackageInfo)] distroStatus distro = asks $ Dist.distroStatus distro . distVersions putDistroPackageList :: DistroName -> [(PackageName, DistroPackageInfo)] -> Update Distros () putDistroPackageList distro list = modify $ \state-> state{ distVersions = Dist.updatePackageList distro list $ distVersions state } packageStatus :: PackageName -> Query Distros [(DistroName, DistroPackageInfo)] packageStatus package = asks $ Dist.packageStatus package . distVersions distroPackageStatus :: DistroName -> PackageName -> Query Distros (Maybe DistroPackageInfo) distroPackageStatus distro package = asks $ Dist.distroPackageStatus distro package . distVersions getDistroMaintainers :: DistroName -> Query Distros UserList getDistroMaintainers name = liftM (fromMaybe Group.empty . Dist.getDistroMaintainers name) (asks distDistros) modifyDistroMaintainers :: DistroName -> (UserList -> UserList) -> Update Distros () modifyDistroMaintainers name func = modify (\distros -> distros {distDistros = Dist.modifyDistroMaintainers name func (distDistros distros) }) addDistroMaintainer :: DistroName -> UserId -> Update Distros () addDistroMaintainer name uid = modifyDistroMaintainers name (Group.add uid) removeDistroMaintainer :: DistroName -> UserId -> Update Distros () removeDistroMaintainer name uid = modifyDistroMaintainers name (Group.remove uid) replaceDistroMaintainers :: DistroName -> UserList -> Update Distros () replaceDistroMaintainers name ulist = modifyDistroMaintainers name (const ulist) makeAcidic ''Distros [ -- update collection of distributions 'addDistro , 'removeDistro -- query collection of distributions , 'enumerateDistros , 'isDistribution -- update package versions in distros , 'addPackage , 'dropPackage -- query status of package versions , 'distroStatus , 'packageStatus , 'distroPackageStatus -- bulk update , 'putDistroPackageList -- import/export , 'getDistributions , 'replaceDistributions -- distro maintainers , 'getDistroMaintainers , 'replaceDistroMaintainers , 'addDistroMaintainer , 'removeDistroMaintainer ]