{-# LANGUAGE DeriveDataTypeable, TypeFamilies, TemplateHaskell #-} module Distribution.Server.Features.PackageCandidates.State where import Distribution.Server.Features.PackageCandidates.Types import Distribution.Server.Framework.MemSize import qualified Distribution.Server.Packages.PackageIndex as PackageIndex import Distribution.Package import Data.Acid (Query, Update, makeAcidic) import Data.SafeCopy (deriveSafeCopy, base) import Data.Typeable import Control.Monad.Reader import qualified Control.Monad.State as State import Data.Monoid ---------------------------------- Index of candidate tarballs and metadata -- boilerplate code based on PackagesState data CandidatePackages = CandidatePackages { candidateList :: !(PackageIndex.PackageIndex CandPkgInfo) } deriving (Typeable, Show, Eq) deriveSafeCopy 0 'base ''CandidatePackages instance MemSize CandidatePackages where memSize (CandidatePackages a) = memSize1 a initialCandidatePackages :: CandidatePackages initialCandidatePackages = CandidatePackages { candidateList = mempty } replaceCandidate :: CandPkgInfo -> Update CandidatePackages () replaceCandidate pkg = State.modify $ \candidates -> candidates { candidateList = replaceVersions (candidateList candidates) } where replaceVersions = PackageIndex.insert pkg . PackageIndex.deletePackageName (packageName pkg) addCandidate :: CandPkgInfo -> Update CandidatePackages () addCandidate pkg = State.modify $ \candidates -> candidates { candidateList = addVersion (candidateList candidates) } where addVersion = PackageIndex.insert pkg deleteCandidate :: PackageId -> Update CandidatePackages () deleteCandidate pkg = State.modify $ \candidates -> candidates { candidateList = deleteVersion (candidateList candidates) } where deleteVersion = PackageIndex.deletePackageId pkg deleteCandidates :: PackageName -> Update CandidatePackages () deleteCandidates pkg = State.modify $ \candidates -> candidates { candidateList = deleteVersions (candidateList candidates) } where deleteVersions = PackageIndex.deletePackageName pkg -- |Replace all existing packages and reports replaceCandidatePackages :: CandidatePackages -> Update CandidatePackages () replaceCandidatePackages = State.put getCandidatePackages :: Query CandidatePackages CandidatePackages getCandidatePackages = ask makeAcidic ''CandidatePackages ['getCandidatePackages ,'replaceCandidatePackages ,'replaceCandidate ,'addCandidate ,'deleteCandidate ,'deleteCandidates ]