mirror of
https://github.com/commercialhaskell/stackage-server.git
synced 2026-01-18 15:11:56 +01:00
Use StackageBranch in Stackage.Database
This commit is contained in:
parent
62c0789ca6
commit
e66813be9f
@ -11,10 +11,13 @@ import qualified Data.HashMap.Strict as HashMap
|
|||||||
import Text.Blaze (text)
|
import Text.Blaze (text)
|
||||||
|
|
||||||
getFeedR :: Handler TypedContent
|
getFeedR :: Handler TypedContent
|
||||||
getFeedR = mkFeed Nothing . snd =<< getSnapshots 20 0
|
getFeedR = getBranchFeed Nothing
|
||||||
|
|
||||||
getBranchFeedR :: StackageBranch -> Handler TypedContent
|
getBranchFeedR :: StackageBranch -> Handler TypedContent
|
||||||
getBranchFeedR branch = mkFeed (Just branch) . snd =<< getBranchSnapshots branch 20 0
|
getBranchFeedR = getBranchFeed . Just
|
||||||
|
|
||||||
|
getBranchFeed :: Maybe StackageBranch -> Handler TypedContent
|
||||||
|
getBranchFeed mBranch = mkFeed mBranch =<< getSnapshots mBranch 20 0
|
||||||
|
|
||||||
mkFeed :: Maybe StackageBranch -> [Entity Snapshot] -> Handler TypedContent
|
mkFeed :: Maybe StackageBranch -> [Entity Snapshot] -> Handler TypedContent
|
||||||
mkFeed _ [] = notFound
|
mkFeed _ [] = notFound
|
||||||
|
|||||||
@ -24,9 +24,10 @@ getAllSnapshotsR = do
|
|||||||
currentPageMay <- lookupGetParam "page"
|
currentPageMay <- lookupGetParam "page"
|
||||||
let currentPage :: Int
|
let currentPage :: Int
|
||||||
currentPage = fromMaybe 1 (currentPageMay >>= readMay)
|
currentPage = fromMaybe 1 (currentPageMay >>= readMay)
|
||||||
(totalCount, map entityVal -> snapshots) <- getSnapshots
|
totalCount <- countSnapshots Nothing
|
||||||
snapshotsPerPage
|
(map entityVal -> snapshots) <-
|
||||||
((fromIntegral currentPage - 1) * snapshotsPerPage)
|
getSnapshots Nothing snapshotsPerPage
|
||||||
|
((fromIntegral currentPage - 1) * snapshotsPerPage)
|
||||||
let groups = groupUp now' snapshots
|
let groups = groupUp now' snapshots
|
||||||
|
|
||||||
let isFirstPage = currentPage == 1
|
let isFirstPage = currentPage == 1
|
||||||
|
|||||||
@ -32,7 +32,7 @@ getStackageDiffR :: SnapName -> SnapName -> Handler Html
|
|||||||
getStackageDiffR name1 name2 = do
|
getStackageDiffR name1 name2 = do
|
||||||
Entity sid1 _ <- lookupSnapshot name1 >>= maybe notFound return
|
Entity sid1 _ <- lookupSnapshot name1 >>= maybe notFound return
|
||||||
Entity sid2 _ <- lookupSnapshot name2 >>= maybe notFound return
|
Entity sid2 _ <- lookupSnapshot name2 >>= maybe notFound return
|
||||||
snapNames <- map (snapshotName . entityVal) . snd <$> getSnapshots 0 0
|
(map (snapshotName . entityVal) -> snapNames) <- getSnapshots Nothing 0 0
|
||||||
let (ltsSnaps, nightlySnaps) = partition isLts $ reverse $ sort snapNames
|
let (ltsSnaps, nightlySnaps) = partition isLts $ reverse $ sort snapNames
|
||||||
snapDiff <- getSnapshotDiff sid1 sid2
|
snapDiff <- getSnapshotDiff sid1 sid2
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
|
|||||||
@ -34,10 +34,7 @@ module Stackage.Database
|
|||||||
, prettyNameShort
|
, prettyNameShort
|
||||||
, getSnapshotsForPackage
|
, getSnapshotsForPackage
|
||||||
, getSnapshots
|
, getSnapshots
|
||||||
, getLtsSnapshots
|
, countSnapshots
|
||||||
, getLtsMajorSnapshots
|
|
||||||
, getNightlySnapshots
|
|
||||||
, getBranchSnapshots
|
|
||||||
, currentSchema
|
, currentSchema
|
||||||
, last5Lts5Nightly
|
, last5Lts5Nightly
|
||||||
, snapshotsJSON
|
, snapshotsJSON
|
||||||
@ -666,73 +663,44 @@ getSnapshotsForPackage pname = run $ do
|
|||||||
Nothing -> Nothing
|
Nothing -> Nothing
|
||||||
Just s -> Just (s, snapshotPackageVersion sp)
|
Just s -> Just (s, snapshotPackageVersion sp)
|
||||||
|
|
||||||
getSnapshots
|
-- | Count snapshots that belong to a specific StackageBranch
|
||||||
:: GetStackageDatabase m
|
countSnapshots :: (GetStackageDatabase m) => Maybe StackageBranch -> m Int
|
||||||
=> Int -- ^ limit
|
countSnapshots Nothing = run $ count ([] :: [Filter Snapshot])
|
||||||
-> Int -- ^ offset
|
countSnapshots (Just NightlyBranch) = run $ count ([] :: [Filter Nightly])
|
||||||
-> m (Int, [Entity Snapshot])
|
countSnapshots (Just LtsBranch) = run $ count ([] :: [Filter Lts])
|
||||||
getSnapshots l o = run $ (,)
|
countSnapshots (Just (LtsMajorBranch x)) = run $ count [LtsMajor ==. x]
|
||||||
<$> count ([] :: [Filter Snapshot])
|
|
||||||
<*> selectList
|
|
||||||
[]
|
|
||||||
[LimitTo l, OffsetBy o, Desc SnapshotCreated]
|
|
||||||
|
|
||||||
getBranchSnapshots :: GetStackageDatabase m
|
-- | Get snapshots that belong to a specific StackageBranch
|
||||||
=> StackageBranch
|
getSnapshots :: (GetStackageDatabase m)
|
||||||
-> Int -- ^ limit
|
=> Maybe StackageBranch
|
||||||
-> Int -- ^ offset
|
-> Int -- ^ limit
|
||||||
-> m (Int, [Entity Snapshot])
|
-> Int -- ^ offset
|
||||||
getBranchSnapshots NightlyBranch = getNightlySnapshots
|
-> m [Entity Snapshot]
|
||||||
getBranchSnapshots LtsBranch = getLtsSnapshots
|
getSnapshots mBranch l o = run $ case mBranch of
|
||||||
getBranchSnapshots (LtsMajorBranch x) = getLtsMajorSnapshots x
|
Nothing -> selectList [] [LimitTo l, OffsetBy o, Desc SnapshotCreated]
|
||||||
|
Just NightlyBranch ->
|
||||||
getLtsSnapshots :: GetStackageDatabase m
|
E.select $ E.from $ \(nightly `E.InnerJoin` snapshot) -> do
|
||||||
=> Int -- ^ limit
|
E.on $ nightly E.^. NightlySnap E.==. snapshot E.^. SnapshotId
|
||||||
-> Int -- ^ offset
|
E.orderBy [E.desc (nightly E.^. NightlyDay)]
|
||||||
-> m (Int, [Entity Snapshot])
|
E.limit $ fromIntegral l
|
||||||
getLtsSnapshots l o = run $ do
|
E.offset $ fromIntegral o
|
||||||
ltsCount <- count ([] :: [Filter Lts])
|
pure snapshot
|
||||||
snapshots <- E.select $ E.from $
|
Just LtsBranch -> do
|
||||||
\(lts `E.InnerJoin` snapshot) -> do
|
E.select $ E.from $ \(lts `E.InnerJoin` snapshot) -> do
|
||||||
E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId
|
E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId
|
||||||
E.orderBy [ E.desc (lts E.^. LtsMajor)
|
E.orderBy [ E.desc (lts E.^. LtsMajor)
|
||||||
, E.desc (lts E.^. LtsMinor) ]
|
, E.desc (lts E.^. LtsMinor) ]
|
||||||
E.limit $ fromIntegral l
|
E.limit $ fromIntegral l
|
||||||
E.offset $ fromIntegral o
|
E.offset $ fromIntegral o
|
||||||
return snapshot
|
pure snapshot
|
||||||
return (ltsCount, snapshots)
|
Just (LtsMajorBranch v) -> do
|
||||||
|
E.select $ E.from $ \(lts `E.InnerJoin` snapshot) -> do
|
||||||
getLtsMajorSnapshots :: GetStackageDatabase m
|
|
||||||
=> Int -- ^ Major version
|
|
||||||
-> Int -- ^ limit
|
|
||||||
-> Int -- ^ offset
|
|
||||||
-> m (Int, [Entity Snapshot])
|
|
||||||
getLtsMajorSnapshots v l o = run $ do
|
|
||||||
ltsCount <- count ([] :: [Filter Lts])
|
|
||||||
snapshots <- E.select $ E.from $
|
|
||||||
\(lts `E.InnerJoin` snapshot) -> do
|
|
||||||
E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId
|
E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId
|
||||||
E.orderBy [E.desc (lts E.^. LtsMinor)]
|
E.orderBy [E.desc (lts E.^. LtsMinor)]
|
||||||
E.where_ ((lts E.^. LtsMajor) E.==. (E.val v))
|
E.where_ ((lts E.^. LtsMajor) E.==. (E.val v))
|
||||||
E.limit $ fromIntegral l
|
E.limit $ fromIntegral l
|
||||||
E.offset $ fromIntegral o
|
E.offset $ fromIntegral o
|
||||||
return snapshot
|
pure snapshot
|
||||||
return (ltsCount, snapshots)
|
|
||||||
|
|
||||||
getNightlySnapshots :: GetStackageDatabase m
|
|
||||||
=> Int -- ^ limit
|
|
||||||
-> Int -- ^ offset
|
|
||||||
-> m (Int, [Entity Snapshot])
|
|
||||||
getNightlySnapshots l o = run $ do
|
|
||||||
nightlyCount <- count ([] :: [Filter Nightly])
|
|
||||||
snapshots <- E.select $ E.from $
|
|
||||||
\(nightly `E.InnerJoin` snapshot) -> do
|
|
||||||
E.on $ nightly E.^. NightlySnap E.==. snapshot E.^. SnapshotId
|
|
||||||
E.orderBy [E.desc (nightly E.^. NightlyDay)]
|
|
||||||
E.limit $ fromIntegral l
|
|
||||||
E.offset $ fromIntegral o
|
|
||||||
return snapshot
|
|
||||||
return (nightlyCount, snapshots)
|
|
||||||
|
|
||||||
last5Lts5Nightly :: GetStackageDatabase m => m [SnapName]
|
last5Lts5Nightly :: GetStackageDatabase m => m [SnapName]
|
||||||
last5Lts5Nightly = run $ do
|
last5Lts5Nightly = run $ do
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user