From e66813be9f23f2829cfa3aa73608b4673adb05ea Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 09:46:28 +0300 Subject: [PATCH] Use StackageBranch in Stackage.Database --- Handler/Feed.hs | 7 +++- Handler/Snapshots.hs | 7 ++-- Handler/StackageHome.hs | 2 +- Stackage/Database.hs | 88 +++++++++++++---------------------------- 4 files changed, 38 insertions(+), 66 deletions(-) diff --git a/Handler/Feed.hs b/Handler/Feed.hs index cf621b0..7e8886e 100644 --- a/Handler/Feed.hs +++ b/Handler/Feed.hs @@ -11,10 +11,13 @@ import qualified Data.HashMap.Strict as HashMap import Text.Blaze (text) getFeedR :: Handler TypedContent -getFeedR = mkFeed Nothing . snd =<< getSnapshots 20 0 +getFeedR = getBranchFeed Nothing 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 _ [] = notFound diff --git a/Handler/Snapshots.hs b/Handler/Snapshots.hs index 0b61b79..b1feeec 100644 --- a/Handler/Snapshots.hs +++ b/Handler/Snapshots.hs @@ -24,9 +24,10 @@ getAllSnapshotsR = do currentPageMay <- lookupGetParam "page" let currentPage :: Int currentPage = fromMaybe 1 (currentPageMay >>= readMay) - (totalCount, map entityVal -> snapshots) <- getSnapshots - snapshotsPerPage - ((fromIntegral currentPage - 1) * snapshotsPerPage) + totalCount <- countSnapshots Nothing + (map entityVal -> snapshots) <- + getSnapshots Nothing snapshotsPerPage + ((fromIntegral currentPage - 1) * snapshotsPerPage) let groups = groupUp now' snapshots let isFirstPage = currentPage == 1 diff --git a/Handler/StackageHome.hs b/Handler/StackageHome.hs index e81d019..7ee954d 100644 --- a/Handler/StackageHome.hs +++ b/Handler/StackageHome.hs @@ -32,7 +32,7 @@ getStackageDiffR :: SnapName -> SnapName -> Handler Html getStackageDiffR name1 name2 = do Entity sid1 _ <- lookupSnapshot name1 >>= 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 snapDiff <- getSnapshotDiff sid1 sid2 defaultLayout $ do diff --git a/Stackage/Database.hs b/Stackage/Database.hs index 6c3d15d..9ffa8db 100644 --- a/Stackage/Database.hs +++ b/Stackage/Database.hs @@ -34,10 +34,7 @@ module Stackage.Database , prettyNameShort , getSnapshotsForPackage , getSnapshots - , getLtsSnapshots - , getLtsMajorSnapshots - , getNightlySnapshots - , getBranchSnapshots + , countSnapshots , currentSchema , last5Lts5Nightly , snapshotsJSON @@ -666,73 +663,44 @@ getSnapshotsForPackage pname = run $ do Nothing -> Nothing Just s -> Just (s, snapshotPackageVersion sp) -getSnapshots - :: GetStackageDatabase m - => Int -- ^ limit - -> Int -- ^ offset - -> m (Int, [Entity Snapshot]) -getSnapshots l o = run $ (,) - <$> count ([] :: [Filter Snapshot]) - <*> selectList - [] - [LimitTo l, OffsetBy o, Desc SnapshotCreated] +-- | Count snapshots that belong to a specific StackageBranch +countSnapshots :: (GetStackageDatabase m) => Maybe StackageBranch -> m Int +countSnapshots Nothing = run $ count ([] :: [Filter Snapshot]) +countSnapshots (Just NightlyBranch) = run $ count ([] :: [Filter Nightly]) +countSnapshots (Just LtsBranch) = run $ count ([] :: [Filter Lts]) +countSnapshots (Just (LtsMajorBranch x)) = run $ count [LtsMajor ==. x] -getBranchSnapshots :: GetStackageDatabase m - => StackageBranch - -> Int -- ^ limit - -> Int -- ^ offset - -> m (Int, [Entity Snapshot]) -getBranchSnapshots NightlyBranch = getNightlySnapshots -getBranchSnapshots LtsBranch = getLtsSnapshots -getBranchSnapshots (LtsMajorBranch x) = getLtsMajorSnapshots x - -getLtsSnapshots :: GetStackageDatabase m - => Int -- ^ limit - -> Int -- ^ offset - -> m (Int, [Entity Snapshot]) -getLtsSnapshots l o = run $ do - ltsCount <- count ([] :: [Filter Lts]) - snapshots <- E.select $ E.from $ - \(lts `E.InnerJoin` snapshot) -> do +-- | Get snapshots that belong to a specific StackageBranch +getSnapshots :: (GetStackageDatabase m) + => Maybe StackageBranch + -> Int -- ^ limit + -> Int -- ^ offset + -> m [Entity Snapshot] +getSnapshots mBranch l o = run $ case mBranch of + Nothing -> selectList [] [LimitTo l, OffsetBy o, Desc SnapshotCreated] + Just NightlyBranch -> + 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 + pure snapshot + Just LtsBranch -> do + E.select $ E.from $ \(lts `E.InnerJoin` snapshot) -> do E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId E.orderBy [ E.desc (lts E.^. LtsMajor) , E.desc (lts E.^. LtsMinor) ] E.limit $ fromIntegral l E.offset $ fromIntegral o - return snapshot - return (ltsCount, snapshots) - -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 + pure snapshot + Just (LtsMajorBranch v) -> do + E.select $ E.from $ \(lts `E.InnerJoin` snapshot) -> do E.on $ lts E.^. LtsSnap E.==. snapshot E.^. SnapshotId E.orderBy [E.desc (lts E.^. LtsMinor)] E.where_ ((lts E.^. LtsMajor) E.==. (E.val v)) E.limit $ fromIntegral l E.offset $ fromIntegral o - return 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) + pure snapshot last5Lts5Nightly :: GetStackageDatabase m => m [SnapName] last5Lts5Nightly = run $ do