From 0e9164e5d65151d8679d9f4845546393f630a8ab Mon Sep 17 00:00:00 2001
From: Konstantin Zudov <konstantin@anche.no>
Date: Tue, 13 Oct 2015 17:58:03 +0300
Subject: [PATCH] Query database to get the preceding SnapName

That's much better than what I did before
---
 Handler/StackageHome.hs        | 4 ++--
 Stackage/Database.hs           | 6 ++++++
 Stackage/Database/Types.hs     | 5 -----
 templates/stackage-home.hamlet | 2 +-
 4 files changed, 9 insertions(+), 8 deletions(-)

diff --git a/Handler/StackageHome.hs b/Handler/StackageHome.hs
index 826cfdd..e81d019 100644
--- a/Handler/StackageHome.hs
+++ b/Handler/StackageHome.hs
@@ -11,13 +11,13 @@ import qualified Data.HashMap.Strict as HashMap
 import Data.These
 import Data.Time (FormatTime)
 import Stackage.Database
-import Stackage.Database.Types (isLts, previousSnapName)
+import Stackage.Database.Types (isLts)
 import Stackage.Snapshot.Diff
 
 getStackageHomeR :: SnapName -> Handler Html
 getStackageHomeR name = do
     Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
-    snapNames <- map (snapshotName . entityVal) . snd <$> getSnapshots 0 0
+    previousSnapName <- fromMaybe name . map snd <$> snapshotBefore (snapshotName snapshot)
     let hoogleForm =
             let queryText = "" :: Text
                 exact = False
diff --git a/Stackage/Database.hs b/Stackage/Database.hs
index d1c2ac1..ce1b92b 100644
--- a/Stackage/Database.hs
+++ b/Stackage/Database.hs
@@ -8,6 +8,7 @@ module Stackage.Database
     , newestLTSMajor
     , ltsMajorVersions
     , newestNightly
+    , snapshotBefore
     , nightlyBefore
     , ltsBefore
     , lookupSnapshot
@@ -428,6 +429,11 @@ newestNightly :: GetStackageDatabase m => m (Maybe Day)
 newestNightly =
     run $ liftM (fmap $ nightlyDay . entityVal) $ selectFirst [] [Desc NightlyDay]
 
+-- | Get the snapshot which precedes the given one with respect to it's branch (nightly/lts)
+snapshotBefore :: GetStackageDatabase m => SnapName -> m (Maybe (SnapshotId, SnapName))
+snapshotBefore (SNLts x y)     = ltsBefore x y
+snapshotBefore (SNNightly day) = nightlyBefore day
+
 nightlyBefore :: GetStackageDatabase m => Day -> m (Maybe (SnapshotId, SnapName))
 nightlyBefore day = do
     run $ liftM (fmap go) $ selectFirst [NightlyDay <. day] [Desc NightlyDay]
diff --git a/Stackage/Database/Types.hs b/Stackage/Database/Types.hs
index 18c0a52..9eb70eb 100644
--- a/Stackage/Database/Types.hs
+++ b/Stackage/Database/Types.hs
@@ -2,7 +2,6 @@ module Stackage.Database.Types
     ( SnapName (..)
     , isLts
     , isNightly
-    , previousSnapName
     ) where
 
 import ClassyPrelude.Conduit
@@ -23,10 +22,6 @@ isNightly :: SnapName -> Bool
 isNightly SNLts{}     = False
 isNightly SNNightly{} = True
 
-previousSnapName :: [SnapName] -> SnapName -> SnapName
-previousSnapName ns n =
-  fromMaybe n $ maximumMay $ filter (< n) $ filter ((isLts n ==) . isLts) ns
-
 instance PersistField SnapName where
     toPersistValue = toPersistValue . toPathPiece
     fromPersistValue v = do
diff --git a/templates/stackage-home.hamlet b/templates/stackage-home.hamlet
index 798e7a8..634b499 100644
--- a/templates/stackage-home.hamlet
+++ b/templates/stackage-home.hamlet
@@ -6,7 +6,7 @@ $newline never
         Published on #{yearMonthDay (snapshotCreated snapshot)}
         <span .separator>
         <span>
-            <a href=@{StackageDiffR (previousSnapName snapNames name) name}>View changes
+            <a href=@{StackageDiffR previousSnapName name}>View changes
         <span .separator>
         <span>
             stack #