haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-12 04:08:29 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Group snapshot list using <optgroup>

Browse Source
This commit is contained in:
Konstantin Zudov 2015-10-11 01:59:01 +03:00
parent c538927aba
commit 734e3b60b3
3 changed files with 36 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
Handler/StackageHome.hs
View File

@ -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 "

22
Stackage/Database/Types.hs
View File

@ -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

34
templates/stackage-diff.hamlet
View File

@ -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>