mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-23 09:21:56 +01:00
More concise recommended list
Problem: it's easy with the current "show four most recent" to run into situations where- for example- only GHC 7.8 has had a successful build in the past few days, and therefore it's the only snapshot that appears. This gives a more consistent and useful listing of recommended snapshots. Styling of this is up for debate.
This commit is contained in:
parent
51744dc54d
commit
71d35bfa4f
@ -2,7 +2,7 @@
|
|||||||
module Handler.Home where
|
module Handler.Home where
|
||||||
|
|
||||||
import Data.Slug
|
import Data.Slug
|
||||||
import Database.Esqueleto as E
|
import Database.Esqueleto as E hiding (isNothing)
|
||||||
import Import hiding ((=.),on,(||.),(==.))
|
import Import hiding ((=.),on,(||.),(==.))
|
||||||
|
|
||||||
-- This is a handler function for the G request method on the HomeR
|
-- This is a handler function for the G request method on the HomeR
|
||||||
@ -14,20 +14,6 @@ import Import hiding ((=.),on,(||.),(==.))
|
|||||||
-- inclined, or create a single monolithic file.
|
-- inclined, or create a single monolithic file.
|
||||||
getHomeR :: Handler Html
|
getHomeR :: Handler Html
|
||||||
getHomeR = do
|
getHomeR = do
|
||||||
fpHandle <- mkSlug "fpcomplete"
|
|
||||||
stackages <- runDB $ select $ from $ \(stackage `InnerJoin` user) -> do
|
|
||||||
on (stackage ^. StackageUser ==. user ^. UserId)
|
|
||||||
orderBy [desc $ stackage ^. StackageUploaded]
|
|
||||||
where_ (like (user ^. UserDisplay) (val "%@fpcomplete.com") ||.
|
|
||||||
user ^. UserHandle ==. val fpHandle)
|
|
||||||
limit 4
|
|
||||||
return
|
|
||||||
( stackage ^. StackageIdent
|
|
||||||
, stackage ^. StackageTitle
|
|
||||||
, stackage ^. StackageUploaded
|
|
||||||
, user ^. UserDisplay
|
|
||||||
, user ^. UserHandle
|
|
||||||
)
|
|
||||||
windowsLatest <- linkFor "unstable-ghc78hp-inclusive"
|
windowsLatest <- linkFor "unstable-ghc78hp-inclusive"
|
||||||
restLatest <- linkFor "unstable-ghc78-inclusive"
|
restLatest <- linkFor "unstable-ghc78-inclusive"
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
@ -48,3 +34,20 @@ getHomeR = do
|
|||||||
runDB .
|
runDB .
|
||||||
select .
|
select .
|
||||||
from
|
from
|
||||||
|
|
||||||
|
addSnapshot title short = do
|
||||||
|
mex <- handlerToWidget $ linkFor $ name "exclusive"
|
||||||
|
min' <- handlerToWidget $ linkFor $ name "inclusive"
|
||||||
|
when (isJust mex || isJust min')
|
||||||
|
[whamlet|
|
||||||
|
<dt>#{asHtml title}
|
||||||
|
<dd>
|
||||||
|
$maybe ex <- mex
|
||||||
|
<a href=@{StackageHomeR ex}>exclusive
|
||||||
|
$if isJust mex && isJust min'
|
||||||
|
\ | #
|
||||||
|
$maybe in <- min'
|
||||||
|
<a href=@{StackageHomeR in}>inclusive
|
||||||
|
|]
|
||||||
|
where
|
||||||
|
name suffix = concat ["unstable-", short, "-", suffix]
|
||||||
|
|||||||
@ -3,11 +3,10 @@
|
|||||||
Stackage is an infrastructure to create stable builds
|
Stackage is an infrastructure to create stable builds
|
||||||
of complete package sets. Think “stable Hackage”.
|
of complete package sets. Think “stable Hackage”.
|
||||||
<h2 .recommended-snapshots>Recommended Snapshots
|
<h2 .recommended-snapshots>Recommended Snapshots
|
||||||
<ul .snapshots>
|
<dl .snapshots>
|
||||||
$forall (E.Value ident, E.Value title, E.Value _uploaded, E.Value _display, E.Value _handle) <- stackages
|
^{addSnapshot "GHC 7.8" "ghc78"}
|
||||||
<li>
|
^{addSnapshot "GHC 7.8 + Haskell Platform" "ghc78hp"}
|
||||||
<a href=@{StackageHomeR ident}>
|
^{addSnapshot "GHC 7.6" "ghc76"}
|
||||||
#{title}
|
|
||||||
<p>
|
<p>
|
||||||
<a href="https://github.com/fpco/stackage/wiki/Stackage-Server-FAQ#whats-the-difference-between-inclusive-and-exclusive-snapshots">What's the difference between inclusive and exclusive snapshots?</a>
|
<a href="https://github.com/fpco/stackage/wiki/Stackage-Server-FAQ#whats-the-difference-between-inclusive-and-exclusive-snapshots">What's the difference between inclusive and exclusive snapshots?</a>
|
||||||
<h2 .getting-started>
|
<h2 .getting-started>
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user