module Distribution.Server.Features.PackageCandidates.Backup where import Distribution.Server.Framework.BackupRestore import Distribution.Server.Framework.BackupDump import Distribution.Server.Features.PackageCandidates.State import Distribution.Server.Features.PackageCandidates.Types import Distribution.Server.Features.Core.Backup as CoreBackup import qualified Distribution.Server.Packages.PackageIndex as PackageIndex import Distribution.Package (PackageId, packageId) import Text.CSV (CSV) import Data.Version (Version(Version), showVersion) import Data.Map (Map) import qualified Data.Map as Map {------------------------------------------------------------------------------- Restore backup -------------------------------------------------------------------------------} data PartialCandidate = PartialCandidate { partialWarnings :: [String] , partialPublic :: Bool } type PartialCandidates = Map PackageId PartialCandidate restoreCandidates :: RestoreBackup CandidatePackages restoreCandidates = updateCandidates Map.empty Map.empty -- We keep the partial packages separate from the rest of the candidate info -- so that we can reuse more of CoreBackup updateCandidates :: PartialIndex -> PartialCandidates -> RestoreBackup CandidatePackages updateCandidates packageMap candidateMap = RestoreBackup { restoreEntry = \entry -> do packageMap' <- doPackageImport packageMap entry candidateMap' <- doCandidateImport candidateMap entry return (updateCandidates packageMap' candidateMap') , restoreFinalize = do let combined = combineMaps packageMap candidateMap results <- mapM mkCandidate (Map.toList combined) return $ CandidatePackages (PackageIndex.fromList results) } where mkCandidate :: (PackageId, (Maybe PartialPkg, Maybe PartialCandidate)) -> Restore CandPkgInfo mkCandidate (pkgId, (Just partialPkg, Just partialCand)) = do pkg <- CoreBackup.partialToFullPkg (pkgId, partialPkg) return CandPkgInfo { candPkgInfo = pkg , candWarnings = partialWarnings partialCand , candPublic = partialPublic partialCand } mkCandidate (pkgId, (Nothing, Just _)) = fail $ show pkgId ++ ": candidate.csv without corresponding package" mkCandidate (pkgId, (Just _, Nothing)) = fail $ show pkgId ++ ": missing candidate.csv" mkCandidate _ = fail "mkCandidate: the impossible happened" combineMaps :: Ord k => Map k a -> Map k b -> Map k (Maybe a, Maybe b) combineMaps map1 map2 = let map1' = Map.map (\x -> (Just x, Nothing)) map1 map2' = Map.map (\y -> (Nothing, Just y)) map2 in Map.unionWith (\e1 e2 -> (fst e1, snd e2)) map1' map2' doCandidateImport :: PartialCandidates -> BackupEntry -> Restore PartialCandidates doCandidateImport candidates (BackupByteString ["package", pkgStr, "candidate.csv"] bs) = do pkgId <- CoreBackup.parsePackageId pkgStr csv <- importCSV "candidate.csv" bs partial <- case csv of [_version, ["public", public], "warnings" : warnings] -> return PartialCandidate { partialWarnings = warnings , partialPublic = read public } _ -> fail "candidate.csv has an invalid format" return (Map.insert pkgId partial candidates) doCandidateImport candidates _ = return candidates {------------------------------------------------------------------------------- Create backup -------------------------------------------------------------------------------} backupCandidates :: CandidatePackages -> [BackupEntry] backupCandidates st = concatMap backupCandidate candidates where candidates :: [CandPkgInfo] candidates = PackageIndex.allPackages (candidateList st) backupCandidate :: CandPkgInfo -> [BackupEntry] backupCandidate candidate = csvToBackup (CoreBackup.pkgPath (packageId candidate) "candidate.csv") (backupExtraInfo candidate) : CoreBackup.infoToAllEntries (candPkgInfo candidate) -- | Backup the information CandPkgInfo adds on top of PkgInfo backupExtraInfo :: CandPkgInfo -> CSV backupExtraInfo candidate = [ [showVersion versionCSV] , ["public", show (candPublic candidate)] , "warnings" : candWarnings candidate ] where versionCSV = Version [0,1] ["unstable"]