Query database to get the preceding SnapName

That's much better than what I did before
This commit is contained in:
Konstantin Zudov 2015-10-13 17:58:03 +03:00
parent a2f2fb79ce
commit 0e9164e5d6
4 changed files with 9 additions and 8 deletions

View File

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

View File

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

View File

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

View File

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