Prefer highest-value LTS (fixes #144)

This commit is contained in:
Michael Snoyman 2016-01-13 11:07:55 +00:00
parent 23fe1adc37
commit de9e250b4e

View File

@ -600,22 +600,30 @@ getLatests :: GetStackageDatabase m
=> Text -- ^ package name => Text -- ^ package name
-> m [LatestInfo] -> m [LatestInfo]
getLatests pname = run $ do getLatests pname = run $ do
mnightly <- latestHelper pname $ \s ln -> s E.^. SnapshotId E.==. ln E.^. NightlySnap mlts <- latestHelper pname
mlts <- latestHelper pname $ \s ln -> s E.^. SnapshotId E.==. ln E.^. LtsSnap (\s ln -> s E.^. SnapshotId E.==. ln E.^. LtsSnap)
return $ concat [mnightly, mlts] (\_ ln ->
[ E.desc $ ln E.^. LtsMajor
, E.desc $ ln E.^. LtsMinor
])
mnightly <- latestHelper pname
(\s ln -> s E.^. SnapshotId E.==. ln E.^. NightlySnap)
(\s _ln -> [E.desc $ s E.^. SnapshotCreated])
return $ concat [mlts, mnightly]
latestHelper latestHelper
:: (From E.SqlQuery E.SqlExpr SqlBackend t, MonadIO m, Functor m) :: (From E.SqlQuery E.SqlExpr SqlBackend t, MonadIO m, Functor m)
=> Text => Text
-> (E.SqlExpr (Entity Snapshot) -> t -> E.SqlExpr (E.Value Bool)) -> (E.SqlExpr (Entity Snapshot) -> t -> E.SqlExpr (E.Value Bool))
-> (E.SqlExpr (Entity Snapshot) -> t -> [E.SqlExpr E.OrderBy])
-> ReaderT SqlBackend m [LatestInfo] -> ReaderT SqlBackend m [LatestInfo]
latestHelper pname clause = fmap (fmap toLatest) $ E.select $ E.from $ \(s,ln,p,sp) -> do latestHelper pname clause order = fmap (fmap toLatest) $ E.select $ E.from $ \(s,ln,p,sp) -> do
E.where_ $ E.where_ $
clause s ln E.&&. clause s ln E.&&.
(s E.^. SnapshotId E.==. sp E.^. SnapshotPackageSnapshot) E.&&. (s E.^. SnapshotId E.==. sp E.^. SnapshotPackageSnapshot) E.&&.
(p E.^. PackageName E.==. E.val pname) E.&&. (p E.^. PackageName E.==. E.val pname) E.&&.
(p E.^. PackageId E.==. sp E.^. SnapshotPackagePackage) (p E.^. PackageId E.==. sp E.^. SnapshotPackagePackage)
E.orderBy [E.desc $ s E.^. SnapshotCreated] E.orderBy $ order s ln
E.limit 1 E.limit 1
return return
( s E.^. SnapshotName ( s E.^. SnapshotName