StackageBranch -> SnapshotBranch
This commit is contained in:
parent
e4a9880fde
commit
c2fb5b1fa5
6 changed files with 19 additions and 19 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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]
|
||||
|
|
4
Types.hs
4
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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue