mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-02-27 18:07:54 +01:00
Fuzz factor for PVP view
This commit is contained in:
parent
1925f11952
commit
0f7a9068a7
@ -10,6 +10,7 @@ import qualified Types
|
|||||||
import Model
|
import Model
|
||||||
import Data.NonNull (fromNullable) -- FIXME expose from ClassyPrelude
|
import Data.NonNull (fromNullable) -- FIXME expose from ClassyPrelude
|
||||||
import Data.Hackage (UploadHistory)
|
import Data.Hackage (UploadHistory)
|
||||||
|
import Data.Time (addUTCTime)
|
||||||
|
|
||||||
viewUnchanged :: Monad m
|
viewUnchanged :: Monad m
|
||||||
=> packageName -> version -> time
|
=> packageName -> version -> time
|
||||||
@ -67,6 +68,14 @@ viewNoBounds _ _ _ =
|
|||||||
getAvailable name maxUploaded =
|
getAvailable name maxUploaded =
|
||||||
map fst . filter ((<= maxUploaded) . snd) . mapToList . fromMaybe mempty . lookup name
|
map fst . filter ((<= maxUploaded) . snd) . mapToList . fromMaybe mempty . lookup name
|
||||||
|
|
||||||
|
-- | We want to allow a certain "fuzz factor" between upload dates, so that if,
|
||||||
|
-- for example, foo and bar are released within a few seconds of each other,
|
||||||
|
-- and bar depends on foo, bar can use that new version of foo, even though
|
||||||
|
-- technically it "wasn't available" yet.
|
||||||
|
--
|
||||||
|
-- The actual value we should use is up for debate. I'm starting with 24 hours.
|
||||||
|
addFuzz = addUTCTime (60 * 60 * 24)
|
||||||
|
|
||||||
viewPVP :: Monad m
|
viewPVP :: Monad m
|
||||||
=> UploadHistory
|
=> UploadHistory
|
||||||
-> packageName -> version -> UTCTime
|
-> packageName -> version -> UTCTime
|
||||||
@ -82,7 +91,7 @@ viewPVP uploadHistory _ _ uploaded =
|
|||||||
go (Dependency name _) | toStr name `member` wiredIn = return $ Dependency name anyVersion
|
go (Dependency name _) | toStr name `member` wiredIn = return $ Dependency name anyVersion
|
||||||
go orig@(Dependency _ range) | hasUpperBound range = return orig
|
go orig@(Dependency _ range) | hasUpperBound range = return orig
|
||||||
go orig@(Dependency nameO@(toStr -> name) range) = do
|
go orig@(Dependency nameO@(toStr -> name) range) = do
|
||||||
let available = getAvailable (fromString name) uploaded uploadHistory
|
let available = getAvailable (fromString name) (addFuzz uploaded) uploadHistory
|
||||||
case fromNullable $ mapMaybe (simpleParse . unpack . toPathPiece) available of
|
case fromNullable $ mapMaybe (simpleParse . unpack . toPathPiece) available of
|
||||||
Nothing -> return orig
|
Nothing -> return orig
|
||||||
Just vs ->
|
Just vs ->
|
||||||
|
|||||||
@ -118,6 +118,7 @@ library
|
|||||||
, Cabal >= 1.18
|
, Cabal >= 1.18
|
||||||
, lifted-base
|
, lifted-base
|
||||||
, mono-traversable
|
, mono-traversable
|
||||||
|
, time
|
||||||
|
|
||||||
executable stackage-server
|
executable stackage-server
|
||||||
if flag(library-only)
|
if flag(library-only)
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user