mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-02-17 05:15:49 +01:00
Query database to get the preceding SnapName
That's much better than what I did before
This commit is contained in:
parent
a2f2fb79ce
commit
0e9164e5d6
@ -11,13 +11,13 @@ 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 (isLts, previousSnapName)
|
import Stackage.Database.Types (isLts)
|
||||||
import Stackage.Snapshot.Diff
|
import Stackage.Snapshot.Diff
|
||||||
|
|
||||||
getStackageHomeR :: SnapName -> Handler Html
|
getStackageHomeR :: SnapName -> Handler Html
|
||||||
getStackageHomeR name = do
|
getStackageHomeR name = do
|
||||||
Entity sid snapshot <- lookupSnapshot name >>= maybe notFound return
|
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 hoogleForm =
|
||||||
let queryText = "" :: Text
|
let queryText = "" :: Text
|
||||||
exact = False
|
exact = False
|
||||||
|
|||||||
@ -8,6 +8,7 @@ module Stackage.Database
|
|||||||
, newestLTSMajor
|
, newestLTSMajor
|
||||||
, ltsMajorVersions
|
, ltsMajorVersions
|
||||||
, newestNightly
|
, newestNightly
|
||||||
|
, snapshotBefore
|
||||||
, nightlyBefore
|
, nightlyBefore
|
||||||
, ltsBefore
|
, ltsBefore
|
||||||
, lookupSnapshot
|
, lookupSnapshot
|
||||||
@ -428,6 +429,11 @@ newestNightly :: GetStackageDatabase m => m (Maybe Day)
|
|||||||
newestNightly =
|
newestNightly =
|
||||||
run $ liftM (fmap $ nightlyDay . entityVal) $ selectFirst [] [Desc NightlyDay]
|
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 :: GetStackageDatabase m => Day -> m (Maybe (SnapshotId, SnapName))
|
||||||
nightlyBefore day = do
|
nightlyBefore day = do
|
||||||
run $ liftM (fmap go) $ selectFirst [NightlyDay <. day] [Desc NightlyDay]
|
run $ liftM (fmap go) $ selectFirst [NightlyDay <. day] [Desc NightlyDay]
|
||||||
|
|||||||
@ -2,7 +2,6 @@ module Stackage.Database.Types
|
|||||||
( SnapName (..)
|
( SnapName (..)
|
||||||
, isLts
|
, isLts
|
||||||
, isNightly
|
, isNightly
|
||||||
, previousSnapName
|
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import ClassyPrelude.Conduit
|
import ClassyPrelude.Conduit
|
||||||
@ -23,10 +22,6 @@ isNightly :: SnapName -> Bool
|
|||||||
isNightly SNLts{} = False
|
isNightly SNLts{} = False
|
||||||
isNightly SNNightly{} = True
|
isNightly SNNightly{} = True
|
||||||
|
|
||||||
previousSnapName :: [SnapName] -> SnapName -> SnapName
|
|
||||||
previousSnapName ns n =
|
|
||||||
fromMaybe n $ maximumMay $ filter (< n) $ filter ((isLts n ==) . isLts) ns
|
|
||||||
|
|
||||||
instance PersistField SnapName where
|
instance PersistField SnapName where
|
||||||
toPersistValue = toPersistValue . toPathPiece
|
toPersistValue = toPersistValue . toPathPiece
|
||||||
fromPersistValue v = do
|
fromPersistValue v = do
|
||||||
|
|||||||
@ -6,7 +6,7 @@ $newline never
|
|||||||
Published on #{yearMonthDay (snapshotCreated snapshot)}
|
Published on #{yearMonthDay (snapshotCreated snapshot)}
|
||||||
<span .separator>
|
<span .separator>
|
||||||
<span>
|
<span>
|
||||||
<a href=@{StackageDiffR (previousSnapName snapNames name) name}>View changes
|
<a href=@{StackageDiffR previousSnapName name}>View changes
|
||||||
<span .separator>
|
<span .separator>
|
||||||
<span>
|
<span>
|
||||||
stack #
|
stack #
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user