From be32c1a177026998cf1c573bf335645479c641fe Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 01:37:29 +0300 Subject: [PATCH 1/7] Added StackageBranch --- Types.hs | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/Types.hs b/Types.hs index f166a5b..2062224 100644 --- a/Types.hs +++ b/Types.hs @@ -20,6 +20,19 @@ instance PathPiece LtsMajor where Right (x, "") <- Just $ Reader.decimal t1 Just $ LtsMajor x +data StackageBranch = LtsMajorBranch Int + | LtsBranch + | NightlyBranch + deriving (Eq, Read, Show) +instance PathPiece StackageBranch where + toPathPiece NightlyBranch = "nightly" + toPathPiece LtsBranch = "lts" + toPathPiece (LtsMajorBranch x) = toPathPiece $ LtsMajor x + + fromPathPiece "nightly" = Just NightlyBranch + fromPathPiece "lts" = Just LtsBranch + fromPathPiece x = (\(LtsMajor x') -> LtsMajorBranch x') <$> fromPathPiece x + newtype PackageName = PackageName { unPackageName :: Text } deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup, PersistField, IsString) instance PersistFieldSql PackageName where From 62c0789ca6bc6747d6dd01e38cbf92572a72a956 Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 07:14:45 +0300 Subject: [PATCH 2/7] Use StackageBranch for Feed --- Handler/Feed.hs | 30 +++++++++++++----------------- Stackage/Database.hs | 11 +++++++++++ config/routes | 4 +--- 3 files changed, 25 insertions(+), 20 deletions(-) diff --git a/Handler/Feed.hs b/Handler/Feed.hs index 76b0e6f..cf621b0 100644 --- a/Handler/Feed.hs +++ b/Handler/Feed.hs @@ -1,8 +1,6 @@ module Handler.Feed ( getFeedR - , getLtsFeedR - , getLtsMajorFeedR - , getNightlyFeedR + , getBranchFeedR ) where import Import @@ -13,21 +11,14 @@ import qualified Data.HashMap.Strict as HashMap import Text.Blaze (text) getFeedR :: Handler TypedContent -getFeedR = mkFeed "" . snd =<< getSnapshots 20 0 +getFeedR = mkFeed Nothing . snd =<< getSnapshots 20 0 -getLtsFeedR :: Handler TypedContent -getLtsFeedR = mkFeed "LTS" . snd =<< getLtsSnapshots 20 0 +getBranchFeedR :: StackageBranch -> Handler TypedContent +getBranchFeedR branch = mkFeed (Just branch) . snd =<< getBranchSnapshots branch 20 0 -getLtsMajorFeedR :: LtsMajor -> Handler TypedContent -getLtsMajorFeedR (LtsMajor v) = - mkFeed ("LTS-" <> tshow v) . snd =<< getLtsMajorSnapshots v 20 0 - -getNightlyFeedR :: Handler TypedContent -getNightlyFeedR = mkFeed "Nightly" . snd =<< getNightlySnapshots 20 0 - -mkFeed :: Text -> [Entity Snapshot] -> Handler TypedContent +mkFeed :: Maybe StackageBranch -> [Entity Snapshot] -> Handler TypedContent mkFeed _ [] = notFound -mkFeed branch snaps = do +mkFeed mBranch snaps = do entries <- forM snaps $ \(Entity snapid snap) -> do content <- getContent snapid snap return FeedEntry @@ -41,15 +32,20 @@ mkFeed branch snaps = do [] -> liftIO getCurrentTime x:_ -> return $ feedEntryUpdated x newsFeed Feed - { feedTitle = "Recent Stackage " <> branch <> " snapshots" + { feedTitle = title , feedLinkSelf = FeedR , feedLinkHome = HomeR , feedAuthor = "Stackage Project" - , feedDescription = text ("Recent Stackage " <> branch <> " snapshots") + , feedDescription = text title , feedLanguage = "en" , feedUpdated = updated , feedEntries = entries } + where + branchTitle NightlyBranch = "Nightly" + branchTitle LtsBranch = "LTS" + branchTitle (LtsMajorBranch x) = "LTS-" <> tshow x + title = "Recent Stackage " <> maybe "" branchTitle mBranch <> " snapshots" getContent :: SnapshotId -> Snapshot -> Handler Html getContent sid2 snap = do diff --git a/Stackage/Database.hs b/Stackage/Database.hs index ce1b92b..6c3d15d 100644 --- a/Stackage/Database.hs +++ b/Stackage/Database.hs @@ -37,6 +37,7 @@ module Stackage.Database , getLtsSnapshots , getLtsMajorSnapshots , getNightlySnapshots + , getBranchSnapshots , currentSchema , last5Lts5Nightly , snapshotsJSON @@ -71,6 +72,7 @@ import System.IO.Temp import qualified Database.Esqueleto as E import Data.Yaml (decode) import qualified Data.Aeson as A +import Types (StackageBranch(..)) currentSchema :: Int currentSchema = 1 @@ -675,6 +677,15 @@ getSnapshots l o = run $ (,) [] [LimitTo l, OffsetBy o, Desc SnapshotCreated] +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 diff --git a/config/routes b/config/routes index 8815f4f..ac7d596 100644 --- a/config/routes +++ b/config/routes @@ -47,9 +47,7 @@ /download/#SupportedArch/#Text DownloadGhcLinksR GET /feed FeedR GET -!/feed/#LtsMajor LtsMajorFeedR GET -/feed/lts LtsFeedR GET -/feed/nightly NightlyFeedR GET +/feed/#StackageBranch BranchFeedR GET /stack DownloadStackListR GET /stack/#Text DownloadStackR GET From e66813be9f23f2829cfa3aa73608b4673adb05ea Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 09:46:28 +0300 Subject: [PATCH 3/7] Use StackageBranch in Stackage.Database --- Handler/Feed.hs | 7 +++- Handler/Snapshots.hs | 7 ++-- Handler/StackageHome.hs | 2 +- Stackage/Database.hs | 90 +++++++++++++---------------------------- 4 files changed, 39 insertions(+), 67 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] - -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 +-- | 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] + +-- | 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 From 5133a38006488b1e1ab001398363211a72684024 Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 09:48:33 +0300 Subject: [PATCH 4/7] Use StackageBranch in OldLinks --- Handler/OldLinks.hs | 14 +++++--------- Handler/Sitemap.hs | 4 ++-- config/routes | 5 +---- 3 files changed, 8 insertions(+), 15 deletions(-) diff --git a/Handler/OldLinks.hs b/Handler/OldLinks.hs index 11f33ea..0e75f59 100644 --- a/Handler/OldLinks.hs +++ b/Handler/OldLinks.hs @@ -1,7 +1,5 @@ module Handler.OldLinks - ( getOldLtsR - , getOldLtsMajorR - , getOldNightlyR + ( getOldStackageBranchR , getOldSnapshotR ) where @@ -28,8 +26,8 @@ redirectWithQueryText url = do req <- waiRequest redirect $ url ++ decodeUtf8 (rawQueryString req) -getOldLtsR :: [Text] -> Handler () -getOldLtsR pieces = do +getOldStackageBranchR :: StackageBranch -> [Text] -> Handler () +getOldStackageBranchR LtsBranch pieces = do (x, y, pieces') <- case pieces of t:ts | Just suffix <- parseLtsSuffix t -> do (x, y) <- case suffix of @@ -44,14 +42,12 @@ getOldLtsR pieces = do let name = concat ["lts-", tshow x, ".", tshow y] redirectWithQueryText $ concatMap (cons '/') $ name : pieces' -getOldLtsMajorR :: LtsMajor -> [Text] -> Handler () -getOldLtsMajorR (LtsMajor x) pieces = do +getOldStackageBranchR (LtsMajorBranch x) pieces = do y <- newestLTSMajor x >>= maybe notFound return let name = concat ["lts-", tshow x, ".", tshow y] redirectWithQueryText $ concatMap (cons '/') $ name : pieces -getOldNightlyR :: [Text] -> Handler () -getOldNightlyR pieces = do +getOldStackageBranchR NightlyBranch pieces = do (day, pieces') <- case pieces of t:ts | Just day <- fromPathPiece t -> return (day, ts) _ -> do diff --git a/Handler/Sitemap.hs b/Handler/Sitemap.hs index 226f2a1..1c08cd1 100644 --- a/Handler/Sitemap.hs +++ b/Handler/Sitemap.hs @@ -11,10 +11,10 @@ getSitemapR :: Handler TypedContent getSitemapR = sitemap $ do priority 1.0 $ HomeR - priority 0.9 $ OldLtsR [] + priority 0.9 $ OldStackageBranchR LtsBranch [] -- TODO: uncomment when this is presentable --priority 0.9 $ DownloadR - priority 0.8 $ OldNightlyR [] + priority 0.8 $ OldStackageBranchR NightlyBranch [] priority 0.7 $ AllSnapshotsR priority 0.7 $ PackageListR diff --git a/config/routes b/config/routes index ac7d596..46a9b68 100644 --- a/config/routes +++ b/config/routes @@ -1,4 +1,4 @@ -!/#LtsMajor/*Texts OldLtsMajorR GET +!/#StackageBranch/*Texts OldStackageBranchR GET /static StaticR Static getStatic /reload WebsiteContentR GitRepo-WebsiteContent websiteContent @@ -32,9 +32,6 @@ /package/#PackageName/snapshots PackageSnapshotsR GET /package PackageListR GET -/lts/*Texts OldLtsR GET -/nightly/*Texts OldNightlyR GET - /authors AuthorsR GET /install InstallR GET /older-releases OlderReleasesR GET From 0fc5bbbf43c3138432495ce64050f78b0d183533 Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 10:56:04 +0300 Subject: [PATCH 5/7] Removed LtsMajor --- Types.hs | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/Types.hs b/Types.hs index 2062224..1d4c37c 100644 --- a/Types.hs +++ b/Types.hs @@ -11,15 +11,6 @@ import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy as LText import qualified Data.Text.Read as Reader -newtype LtsMajor = LtsMajor Int - deriving (Eq, Read, Show) -instance PathPiece LtsMajor where - toPathPiece (LtsMajor x) = "lts-" ++ tshow x - fromPathPiece t0 = do - t1 <- stripPrefix "lts-" t0 - Right (x, "") <- Just $ Reader.decimal t1 - Just $ LtsMajor x - data StackageBranch = LtsMajorBranch Int | LtsBranch | NightlyBranch @@ -27,11 +18,14 @@ data StackageBranch = LtsMajorBranch Int instance PathPiece StackageBranch where toPathPiece NightlyBranch = "nightly" toPathPiece LtsBranch = "lts" - toPathPiece (LtsMajorBranch x) = toPathPiece $ LtsMajor x + toPathPiece (LtsMajorBranch x) = "lts-" ++ tshow x fromPathPiece "nightly" = Just NightlyBranch - fromPathPiece "lts" = Just LtsBranch - fromPathPiece x = (\(LtsMajor x') -> LtsMajorBranch x') <$> fromPathPiece x + fromPathPiece "lts" = Just LtsBranch + fromPathPiece t0 = do + t1 <- stripPrefix "lts-" t0 + Right (x, "") <- Just $ Reader.decimal t1 + Just $ LtsMajorBranch x newtype PackageName = PackageName { unPackageName :: Text } deriving (Show, Read, Typeable, Eq, Ord, Hashable, PathPiece, ToMarkup, PersistField, IsString) From e4a9880fde476a3963891d89c96035b24633c06d Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 13:03:45 +0300 Subject: [PATCH 6/7] Remove obsolete TODO --- Handler/Sitemap.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/Handler/Sitemap.hs b/Handler/Sitemap.hs index 1c08cd1..27d6e3c 100644 --- a/Handler/Sitemap.hs +++ b/Handler/Sitemap.hs @@ -12,8 +12,6 @@ getSitemapR = sitemap $ do priority 1.0 $ HomeR priority 0.9 $ OldStackageBranchR LtsBranch [] - -- TODO: uncomment when this is presentable - --priority 0.9 $ DownloadR priority 0.8 $ OldStackageBranchR NightlyBranch [] priority 0.7 $ AllSnapshotsR From c2fb5b1fa5bf4274666bfa886fbdb7aaab1dd27e Mon Sep 17 00:00:00 2001 From: Konstantin Zudov Date: Fri, 16 Oct 2015 15:01:40 +0300 Subject: [PATCH 7/7] StackageBranch -> SnapshotBranch --- Handler/Feed.hs | 6 +++--- Handler/OldLinks.hs | 10 +++++----- Handler/Sitemap.hs | 4 ++-- Stackage/Database.hs | 10 +++++----- Types.hs | 4 ++-- config/routes | 4 ++-- 6 files changed, 19 insertions(+), 19 deletions(-) diff --git a/Handler/Feed.hs b/Handler/Feed.hs index 7e8886e..3e39457 100644 --- a/Handler/Feed.hs +++ b/Handler/Feed.hs @@ -13,13 +13,13 @@ import Text.Blaze (text) getFeedR :: Handler TypedContent getFeedR = getBranchFeed Nothing -getBranchFeedR :: StackageBranch -> Handler TypedContent +getBranchFeedR :: SnapshotBranch -> Handler TypedContent getBranchFeedR = getBranchFeed . Just -getBranchFeed :: Maybe StackageBranch -> Handler TypedContent +getBranchFeed :: Maybe SnapshotBranch -> Handler TypedContent getBranchFeed mBranch = mkFeed mBranch =<< getSnapshots mBranch 20 0 -mkFeed :: Maybe StackageBranch -> [Entity Snapshot] -> Handler TypedContent +mkFeed :: Maybe SnapshotBranch -> [Entity Snapshot] -> Handler TypedContent mkFeed _ [] = notFound mkFeed mBranch snaps = do entries <- forM snaps $ \(Entity snapid snap) -> do diff --git a/Handler/OldLinks.hs b/Handler/OldLinks.hs index 0e75f59..052a3d1 100644 --- a/Handler/OldLinks.hs +++ b/Handler/OldLinks.hs @@ -1,5 +1,5 @@ module Handler.OldLinks - ( getOldStackageBranchR + ( getOldSnapshotBranchR , getOldSnapshotR ) where @@ -26,8 +26,8 @@ redirectWithQueryText url = do req <- waiRequest redirect $ url ++ decodeUtf8 (rawQueryString req) -getOldStackageBranchR :: StackageBranch -> [Text] -> Handler () -getOldStackageBranchR LtsBranch pieces = do +getOldSnapshotBranchR :: SnapshotBranch -> [Text] -> Handler () +getOldSnapshotBranchR LtsBranch pieces = do (x, y, pieces') <- case pieces of t:ts | Just suffix <- parseLtsSuffix t -> do (x, y) <- case suffix of @@ -42,12 +42,12 @@ getOldStackageBranchR LtsBranch pieces = do let name = concat ["lts-", tshow x, ".", tshow y] redirectWithQueryText $ concatMap (cons '/') $ name : pieces' -getOldStackageBranchR (LtsMajorBranch x) pieces = do +getOldSnapshotBranchR (LtsMajorBranch x) pieces = do y <- newestLTSMajor x >>= maybe notFound return let name = concat ["lts-", tshow x, ".", tshow y] redirectWithQueryText $ concatMap (cons '/') $ name : pieces -getOldStackageBranchR NightlyBranch pieces = do +getOldSnapshotBranchR NightlyBranch pieces = do (day, pieces') <- case pieces of t:ts | Just day <- fromPathPiece t -> return (day, ts) _ -> do diff --git a/Handler/Sitemap.hs b/Handler/Sitemap.hs index 27d6e3c..4d60c7c 100644 --- a/Handler/Sitemap.hs +++ b/Handler/Sitemap.hs @@ -11,8 +11,8 @@ getSitemapR :: Handler TypedContent getSitemapR = sitemap $ do priority 1.0 $ HomeR - priority 0.9 $ OldStackageBranchR LtsBranch [] - priority 0.8 $ OldStackageBranchR NightlyBranch [] + priority 0.9 $ OldSnapshotBranchR LtsBranch [] + priority 0.8 $ OldSnapshotBranchR NightlyBranch [] priority 0.7 $ AllSnapshotsR priority 0.7 $ PackageListR diff --git a/Stackage/Database.hs b/Stackage/Database.hs index 9ffa8db..1233fb3 100644 --- a/Stackage/Database.hs +++ b/Stackage/Database.hs @@ -69,7 +69,7 @@ import System.IO.Temp import qualified Database.Esqueleto as E import Data.Yaml (decode) import qualified Data.Aeson as A -import Types (StackageBranch(..)) +import Types (SnapshotBranch(..)) currentSchema :: Int currentSchema = 1 @@ -663,16 +663,16 @@ getSnapshotsForPackage pname = run $ do Nothing -> Nothing Just s -> Just (s, snapshotPackageVersion sp) --- | Count snapshots that belong to a specific StackageBranch -countSnapshots :: (GetStackageDatabase m) => Maybe StackageBranch -> m Int +-- | Count snapshots that belong to a specific SnapshotBranch +countSnapshots :: (GetStackageDatabase m) => Maybe SnapshotBranch -> 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] --- | Get snapshots that belong to a specific StackageBranch +-- | Get snapshots that belong to a specific SnapshotBranch getSnapshots :: (GetStackageDatabase m) - => Maybe StackageBranch + => Maybe SnapshotBranch -> Int -- ^ limit -> Int -- ^ offset -> m [Entity Snapshot] diff --git a/Types.hs b/Types.hs index 1d4c37c..d4e97d2 100644 --- a/Types.hs +++ b/Types.hs @@ -11,11 +11,11 @@ import qualified Data.Text.Lazy.Builder as Builder import qualified Data.Text.Lazy as LText import qualified Data.Text.Read as Reader -data StackageBranch = LtsMajorBranch Int +data SnapshotBranch = LtsMajorBranch Int | LtsBranch | NightlyBranch deriving (Eq, Read, Show) -instance PathPiece StackageBranch where +instance PathPiece SnapshotBranch where toPathPiece NightlyBranch = "nightly" toPathPiece LtsBranch = "lts" toPathPiece (LtsMajorBranch x) = "lts-" ++ tshow x diff --git a/config/routes b/config/routes index 46a9b68..9303cd0 100644 --- a/config/routes +++ b/config/routes @@ -1,4 +1,4 @@ -!/#StackageBranch/*Texts OldStackageBranchR GET +!/#SnapshotBranch/*Texts OldSnapshotBranchR GET /static StaticR Static getStatic /reload WebsiteContentR GitRepo-WebsiteContent websiteContent @@ -44,7 +44,7 @@ /download/#SupportedArch/#Text DownloadGhcLinksR GET /feed FeedR GET -/feed/#StackageBranch BranchFeedR GET +/feed/#SnapshotBranch BranchFeedR GET /stack DownloadStackListR GET /stack/#Text DownloadStackR GET