/lts and /nightly routes are set up

Handler/Alias.hs

@@ -1,7 +1,15 @@
-module Handler.Alias where
+module Handler.Alias
+    ( handleAliasR
+    , getLtsR
+    , getNightlyR
+    ) where
 
 import Import
 import Data.Slug (Slug)
+import Data.Text.Read (decimal)
+import Handler.StackageHome (getStackageHomeR, getStackageMetadataR, getStackageCabalConfigR)
+import Handler.StackageIndex (getStackageIndexR, getStackageBundleR)
+import Handler.StackageSdist (getStackageSdistR)
 
 handleAliasR :: Slug -> Slug -> [Text] -> Handler ()
 handleAliasR user name pieces = do
@@ -13,3 +21,66 @@ handleAliasR user name pieces = do
     case parseRoute ("stackage" : toPathPiece setid : pieces, []) of
         Nothing -> notFound
         Just route -> redirect (route :: Route App)
+
+parseLtsPair :: Text -> Maybe (Int, Int)
+parseLtsPair t1 = do
+    (x, t2) <- either (const Nothing) Just $ decimal t1
+    t3 <- stripPrefix "." t2
+    (y, "") <- either (const Nothing) Just $ decimal t3
+    Just (x, y)
+
+getLtsR :: [Text] -> Handler ()
+getLtsR pieces0 =
+    case pieces0 of
+        [] -> go []
+        piece:pieces'
+            | Just (x, y) <- parseLtsPair piece -> goXY x y pieces'
+            | Just x <- fromPathPiece piece -> goX x pieces'
+            | otherwise -> go pieces0
+  where
+    go pieces = do
+        mlts <- runDB $ selectFirst [] [Desc LtsMajor, Desc LtsMinor]
+        case mlts of
+            Nothing -> notFound
+            Just (Entity _ (Lts _ _ sid)) -> goSid sid pieces
+
+    goX x pieces = do
+        mlts <- runDB $ selectFirst [LtsMajor ==. x] [Desc LtsMinor]
+        case mlts of
+            Nothing -> notFound
+            Just (Entity _ (Lts _ _ sid)) -> goSid sid pieces
+
+    goXY x y pieces = do
+        Entity _ (Lts _ _ sid) <- runDB $ getBy404 $ UniqueLts x y
+        goSid sid pieces
+
+getNightlyR :: [Text] -> Handler ()
+getNightlyR pieces0 =
+    case pieces0 of
+        [] -> go []
+        piece:pieces'
+            | Just day <- fromPathPiece piece -> goDay day pieces'
+            | otherwise -> go pieces0
+  where
+    go pieces = do
+        mn <- runDB $ selectFirst [] [Desc NightlyDay]
+        case mn of
+            Nothing -> notFound
+            Just (Entity _ (Nightly _ _ sid)) -> goSid sid pieces
+    goDay day pieces = do
+        Entity _ (Nightly _ _ sid) <- runDB $ getBy404 $ UniqueNightly day
+        goSid sid pieces
+
+goSid :: StackageId -> [Text] -> Handler ()
+goSid sid pieces = do
+    s <- runDB $ get404 sid
+    case parseRoute ("snapshot" : toPathPiece (stackageSlug s) : pieces, []) of
+        Just (SnapshotR slug sr) ->
+            case sr of
+                StackageHomeR -> getStackageHomeR slug >>= sendResponse
+                StackageMetadataR -> getStackageMetadataR slug >>= sendResponse
+                StackageCabalConfigR -> getStackageCabalConfigR slug >>= sendResponse
+                StackageIndexR -> getStackageIndexR slug >>= sendResponse
+                StackageBundleR -> getStackageBundleR slug >>= sendResponse
+                StackageSdistR pnv -> getStackageSdistR slug pnv >>= sendResponse
+        _ -> notFound

Handler/Haddock.hs

@@ -45,7 +45,7 @@ getUploadHaddockR slug0 = do
             master <- getYesod
             void $ liftIO $ forkIO $ haddockUnpacker master True ident
             setMessage "Haddocks uploaded"
-            redirect $ StackageHomeR slug
+            redirect $ SnapshotR slug StackageHomeR
         _ -> defaultLayout $ do
             setTitle "Upload Haddocks"
             $(widgetFile "upload-haddock")

Handler/Home.hs

@@ -53,11 +53,11 @@ getHomeR = do
                          #{asHtml title}
                      <td>
                          $maybe ex <- mex
-                           <a href=@{StackageHomeR ex}>exclusive
+                           <a href=@{SnapshotR ex StackageHomeR}>exclusive
                          $if isJust mex && isJust min'
                      <td>
                          $maybe in <- min'
-                           <a href=@{StackageHomeR in}>inclusive
+                           <a href=@{SnapshotR in StackageHomeR}>inclusive
               |]
         where
           name suffix = concat ["unstable-", short, "-", suffix]

Handler/UploadStackage.hs

@@ -125,7 +125,7 @@ putUploadStackageR = do
 
                                 setAlias
 
-                                done "Stackage created" $ StackageHomeR slug
+                                done "Stackage created" $ SnapshotR slug StackageHomeR
                             else do
                                 done "Error creating index file" ProfileR
 

config/models

@@ -99,3 +99,15 @@ BannedTag
 Migration
     num Int
     UniqueMigration num
+
+Nightly
+    day Day
+    ghcVersion Text
+    stackage StackageId
+    UniqueNightly day
+
+Lts
+    major Int
+    minor Int
+    stackage StackageId
+    UniqueLts major minor

config/routes

@@ -15,12 +15,13 @@
 
 /stackage/#PackageSetIdent/*Texts OldStackageR GET
 
-/snapshot/#SnapSlug StackageHomeR GET
+/snapshot/#SnapSlug SnapshotR:
-/snapshot/#SnapSlug/metadata StackageMetadataR GET
+    / StackageHomeR GET
-/snapshot/#SnapSlug/cabal.config StackageCabalConfigR GET
+    /metadata StackageMetadataR GET
-/snapshot/#SnapSlug/00-index.tar.gz StackageIndexR GET
+    /cabal.config StackageCabalConfigR GET
-/snapshot/#SnapSlug/bundle StackageBundleR GET
+    /00-index.tar.gz StackageIndexR GET
-/snapshot/#SnapSlug/package/#PackageNameVersion StackageSdistR GET
+    /bundle StackageBundleR GET
+    /package/#PackageNameVersion StackageSdistR GET
 
 /hackage-view/#HackageView/00-index.tar.gz HackageViewIndexR GET
 /hackage-view/#HackageView/package/#PackageNameVersion HackageViewSdistR GET
@@ -39,3 +40,6 @@
 /tags TagListR GET
 /tag/#Slug TagR GET
 /banned-tags BannedTagsR GET PUT
+
+/lts/*Texts LtsR GET
+/nightly/*Texts NightlyR GET

templates/all-snapshots.hamlet

@@ -8,7 +8,7 @@
             $forall (ident, title, _uploaded, display, handle) <- stackages
                 <li>
                     <strong>
-                        <a href=@{StackageHomeR ident}>
+                        <a href=@{SnapshotR ident StackageHomeR}>
                             #{title}
                     <p>
                         #{display} (#{handle})

templates/package.hamlet

@@ -131,7 +131,7 @@ $newline never
                            <td>
                                #{version}
                            <td>
-                               <a href=@{StackageHomeR slug}>#{fromMaybe title $ stripSuffix ", exclusive" title}
+                               <a href=@{SnapshotR slug StackageHomeR}>#{fromMaybe title $ stripSuffix ", exclusive" title}
 
 <div .markdown-container .readme-container>
     <div .container>

templates/stackage-home.hamlet

@@ -7,15 +7,15 @@ $newline never
         $if hasBundle
            <span .separator>
            <span>
-               <a href=@{StackageMetadataR slug} title="View metadata on this snapshot, such as package versions">
+               <a href=@{SnapshotR slug StackageMetadataR} title="View metadata on this snapshot, such as package versions">
                    \Metadata
            <span .separator>
            <span>
-               <a href=@{StackageBundleR slug} title="This is useful for making modifications to an existing snapshot">
+               <a href=@{SnapshotR slug StackageBundleR} title="This is useful for making modifications to an existing snapshot">
                    \Bundle
            <span .separator>
            <span>
-               <a href=@{StackageCabalConfigR slug} title="If you want to stick with upstream Hackage but get a stable package set">
+               <a href=@{SnapshotR slug StackageCabalConfigR} title="If you want to stick with upstream Hackage but get a stable package set">
                    \cabal.config
            $if stackageHasHaddocks stackage
                <span .separator>
@@ -28,7 +28,7 @@ $newline never
             .
     <p>
         <pre>
-            remote-repo: stackage-#{slug}:@{StackageHomeR slug}
+            remote-repo: stackage-#{slug}:@{SnapshotR slug StackageHomeR}
     $maybe _ <- minclusive
         <p>
             <a href="https://github.com/fpco/stackage/wiki/Stackage-Server-FAQ#whats-the-difference-between-inclusive-and-exclusive-snapshots">What's the difference between inclusive and exclusive snapshots?</a>

templates/upload-haddock.hamlet

@@ -2,7 +2,7 @@
     <h1>Upload Haddocks
 
     <p>
-        <a href=@{StackageHomeR slug}>Return to snapshot
+        <a href=@{SnapshotR slug StackageHomeR}>Return to snapshot
 
     $if stackageHasHaddocks
         <div .alert .alert-warning>You have already uploaded Haddocks. Uploading again will delete the old contents.