haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-20 07:51:55 +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.These
import Data.Time (FormatTime) import Data.Time (FormatTime)
import Stackage.Database import Stackage.Database
import Stackage.Database.Types (sortNicely, previousSnapName) import Stackage.Database.Types (isLts, previousSnapName)
import Stackage.Snapshot.Diff import Stackage.Snapshot.Diff
getStackageHomeR :: SnapName -> Handler Html getStackageHomeR :: SnapName -> Handler Html
@ -32,7 +32,8 @@ getStackageDiffR :: SnapName -> SnapName -> Handler Html
getStackageDiffR name1 name2 = do getStackageDiffR name1 name2 = do
Entity sid1 s1 <- lookupSnapshot name1 >>= maybe notFound return Entity sid1 s1 <- lookupSnapshot name1 >>= maybe notFound return
Entity sid2 s2 <- lookupSnapshot name2 >>= 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 snapDiff <- getSnapshotDiff sid1 sid2
defaultLayout $ do defaultLayout $ do
setTitle $ "Compare " ++ toHtml (toPathPiece name1) ++ " with " setTitle $ "Compare " ++ toHtml (toPathPiece name1) ++ " with "

22
Stackage/Database/Types.hs
View File

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

34
templates/stackage-diff.hamlet
View File

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