From 17ad688aad92e6ba13d67bc4748d50b90fcf8507 Mon Sep 17 00:00:00 2001
From: Alexey Kuleshevich <alexey@kuleshevi.ch>
Date: Sun, 15 Nov 2020 00:03:02 +0300
Subject: [PATCH] Attempt to replace expensive query with a Haskell alternative

---
 src/Stackage/Database/Query.hs | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/src/Stackage/Database/Query.hs b/src/Stackage/Database/Query.hs
index 073141a..bba484a 100644
--- a/src/Stackage/Database/Query.hs
+++ b/src/Stackage/Database/Query.hs
@@ -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