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 , spiChangelog = unValue cl
} }
getSnapshotPackageLatestVersionQuery :: getSnapshotPackageLatestVersionQuery ::
PackageNameP -> ReaderT SqlBackend (RIO env) (Maybe SnapshotPackageInfo) PackageNameP -> ReaderT SqlBackend (RIO env) (Maybe SnapshotPackageInfo)
getSnapshotPackageLatestVersionQuery pname = getSnapshotPackageLatestVersionQuery pname = do
fmap snd . listToMaybe <$> versions <-
(snapshotPackageInfoQuery $ \_sp s pn v spiQ -> do select $
where_ (pn ^. PackageNameName ==. val pname) from $ \(sp `InnerJoin` pn `InnerJoin` v) -> do
orderBy [desc (versionArray v), desc (s ^. SnapshotCreated)] on (sp ^. SnapshotPackageVersion ==. v ^. VersionId)
limit 1 on (sp ^. SnapshotPackagePackageName ==. pn ^. PackageNameId)
pure ((), spiQ)) 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 :: getSnapshotPackageLatestVersion ::
GetStackageDatabase env m GetStackageDatabase env m