Group snapshot list using <optgroup>

Handler/StackageHome.hs

@@ -11,7 +11,7 @@ import qualified Data.HashMap.Strict as HashMap
 import Data.These
 import Data.Time (FormatTime)
 import Stackage.Database
-import Stackage.Database.Types (sortNicely, previousSnapName)
+import Stackage.Database.Types (isLts, previousSnapName)
 import Stackage.Snapshot.Diff
 
 getStackageHomeR :: SnapName -> Handler Html
@@ -32,7 +32,8 @@ getStackageDiffR :: SnapName -> SnapName -> Handler Html
 getStackageDiffR name1 name2 = do
     Entity sid1 s1 <- lookupSnapshot name1 >>= maybe notFound return
     Entity sid2 s2 <- lookupSnapshot name2 >>= maybe notFound return
-    snapNames <- sortNicely . map snapshotName . snd <$> getSnapshots 0 0
+    snapNames <- map snapshotName . snd <$> getSnapshots 0 0
+    let (ltsSnaps, nightlySnaps) = partition isLts $ reverse $ sort snapNames
     snapDiff <- getSnapshotDiff sid1 sid2
     defaultLayout $ do
         setTitle $ "Compare " ++ toHtml (toPathPiece name1) ++ " with "

Stackage/Database/Types.hs

@@ -1,6 +1,7 @@
 module Stackage.Database.Types
     ( SnapName (..)
-    , sortNicely
+    , isLts
+    , isNightly
     , previousSnapName
     ) where
 
@@ -14,22 +15,17 @@ data SnapName = SNLts !Int !Int
               | SNNightly !Day
     deriving (Eq, Ord, Read, Show)
 
-isLTS :: SnapName -> Bool
-isLTS SNLts{}     = True
-isLTS SNNightly{} = False
+isLts :: SnapName -> Bool
+isLts SNLts{}     = True
+isLts SNNightly{} = False
 
--- | Sorts a list of SnapName's in a way suitable for rendering a select list.
---   Order:
---     1. LTS snapshots (recent first)
---     2. Nightly snapshots (recent first)
---     3. Anything else
-sortNicely :: [SnapName] -> [SnapName]
-sortNicely ns = reverse (sort lts) ++ reverse (sort nightly)
-  where (lts, nightly) = partition isLTS ns
+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
+  fromMaybe n $ maximumMay $ filter (< n) $ filter ((isLts n ==) . isLts) ns
 
 instance PersistField SnapName where
     toPersistValue = toPersistValue . toPathPiece

templates/stackage-diff.hamlet

@@ -6,18 +6,32 @@
       <thead>
         <th>
           <select .form-control onchange="document.location = this.value">
-            $forall name1' <- snapNames
-              $if name1' == name1
-                <option selected value=@{StackageDiffR name1' name2}>#{toPathPiece name1'}
-              $else
-                <option value=@{StackageDiffR name1' name2}>#{toPathPiece name1'}
+            <optgroup label="LTS">
+              $forall name1' <- ltsSnaps
+                $if name1' == name1
+                  <option selected value=@{StackageDiffR name1' name2}>#{toPathPiece name1'}
+                $else
+                  <option value=@{StackageDiffR name1' name2}>#{toPathPiece name1'}
+            <optgroup label="Nightly">
+              $forall name1' <- nightlySnaps
+                $if name1' == name1
+                  <option selected value=@{StackageDiffR name1' name2}>#{toPathPiece name1'}
+                $else
+                  <option value=@{StackageDiffR name1' name2}>#{toPathPiece name1'}
         <th>
           <select .form-control onchange="document.location = this.value">
-            $forall name2' <- snapNames
-              $if name2' == name2
-                <option selected value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'}
-              $else
-                <option value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'}
+            <optgroup label="LTS">
+              $forall name2' <- ltsSnaps
+                $if name2' == name2
+                  <option selected value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'}
+                $else
+                  <option value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'}
+            <optgroup label="Nightly">
+              $forall name2' <- nightlySnaps
+                $if name2' == name2
+                  <option selected value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'}
+                $else
+                  <option value=@{StackageDiffR name1 name2'}>#{toPathPiece name2'}
       <tbody>
         $forall (name, VersionChange verChange) <- HashMap.toList snapDiff
           <tr>