haskell/hackage-server
1
1
Fork 0
mirror of https://github.com/haskell/hackage-server.git synced 2024-11-28 14:22:38 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #1225 from RaoulHC/avoid-repeated-tarball-mirroring

Browse Source 
Filter out metadata revisions in index before mirroring
This commit is contained in:
gbaz 2023-10-17 18:46:45 -04:00 committed by GitHub
commit 5662ff4a0d
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 10 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
exes/MirrorClient.hs
View File

@ -4,7 +4,9 @@ module Main (main) where
import Control.Exception
import Control.Monad
import Control.Monad.Trans
import Data.Function (on)
import Data.List
import qualified Data.List.NonEmpty as NonEmpty
import Data.Version
import Network.Browser
import System.Directory
@ -118,10 +120,14 @@ mirrorOnce verbosity opts
| null (selectedPkgs opts) = pkgsMissingFromDest
| otherwise = subsetIndex (selectedPkgs opts)
pkgsMissingFromDest
pkgsToMirror' = filter (\(PkgIndexInfo pkg _ _ _) ->
pkg `Set.notMember` missingPkgs
&& pkg `Set.notMember` unmirrorablePkgs )
pkgsToMirror
byPkgId cmp = on cmp (\(PkgIndexInfo pkg _ _ _) -> pkg)
pkgsToMirror'
-- Remove any duplicates in the index from metadata revisions
= map NonEmpty.head . NonEmpty.groupBy (byPkgId (==)) . sortBy (byPkgId compare)
$ filter (\(PkgIndexInfo pkg _ _ _) ->
pkg `Set.notMember` missingPkgs
&& pkg `Set.notMember` unmirrorablePkgs)
pkgsToMirror
mirrorCount = length pkgsToMirror'
ignoreCount = length pkgsToMirror - mirrorCount