haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-02-09 09:37:31 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Attempt to replace expensive query with a Haskell alternative

Browse Source
This commit is contained in:
Alexey Kuleshevich 2020-11-15 00:03:02 +03:00
parent af20bc6291
commit 17ad688aad
No known key found for this signature in database
GPG Key ID: E59B216127119E3E
1 changed files with 15 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
src/Stackage/Database/Query.hs
View File

@ -611,16 +611,23 @@ snapshotPackageInfoQuery customize =
, spiChangelog = unValue cl
}
getSnapshotPackageLatestVersionQuery ::
PackageNameP -> ReaderT SqlBackend (RIO env) (Maybe SnapshotPackageInfo)
getSnapshotPackageLatestVersionQuery pname =
fmap snd . listToMaybe <$>
(snapshotPackageInfoQuery $ \_sp s pn v spiQ -> do
where_ (pn ^. PackageNameName ==. val pname)
orderBy [desc (versionArray v), desc (s ^. SnapshotCreated)]
limit 1
pure ((), spiQ))
getSnapshotPackageLatestVersionQuery pname = do
versions <-
select $
from $ \(sp `InnerJoin` pn `InnerJoin` v) -> do
on (sp ^. SnapshotPackageVersion ==. v ^. VersionId)
on (sp ^. SnapshotPackagePackageName ==. pn ^. PackageNameId)
where_ $ pn ^. PackageNameName ==. val pname
pure (v ^. VersionVersion, sp ^. SnapshotPackageId)
case L.sortOn Down [(v, spid) | (Value v, Value spid) <- versions] of
[] -> pure Nothing
(_, spid):_ ->
fmap snd . listToMaybe <$>
(snapshotPackageInfoQuery $ \sp _s _pn _v spiQ -> do
where_ $ sp ^. SnapshotPackageId ==. val spid
pure ((), spiQ))
getSnapshotPackageLatestVersion ::
GetStackageDatabase env m