Download links for latest Stack (fixes commercialhaskell/stack#532)

Application.hs

@@ -25,6 +25,7 @@ import           Yesod.Default.Main
 import           Yesod.GitRepo
 import           System.Process (rawSystem)
 import           Stackage.Database.Cron (loadFromS3)
+import           Control.AutoUpdate
 
 import qualified Echo
 
@@ -46,6 +47,7 @@ import           Handler.BuildPlan
 import           Handler.Download
 import           Handler.OldLinks
 import           Handler.Feed
+import           Handler.DownloadStack
 
 -- This line actually creates our YesodDispatch instance. It is the second half
 -- of the call to mkYesodData which occurs in Foundation.hs. Please see the
@@ -128,6 +130,12 @@ makeFoundation useEcho conf = do
         handleAny print refreshDB
         handleAny print $ grRefresh websiteContent'
 
+    latestStackMatcher' <- mkAutoUpdate defaultUpdateSettings
+        { updateFreq = 1000 * 1000 * 60 * 30
+        -- ^ update every thirty minutes
+        , updateAction = getLatestMatcher manager
+        }
+
     let logger = Yesod.Core.Types.Logger loggerSet' getter
         foundation = App
             { settings = conf
@@ -137,6 +145,7 @@ makeFoundation useEcho conf = do
             , genIO = gen
             , websiteContent = websiteContent'
             , stackageDatabase = stackageDatabase'
+            , latestStackMatcher = latestStackMatcher'
             }
 
     return foundation

Data/WebsiteContent.hs

@@ -1,11 +1,14 @@
 module Data.WebsiteContent
     ( WebsiteContent (..)
+    , StackRelease (..)
     , loadWebsiteContent
     ) where
 
 import ClassyPrelude.Yesod
 import Text.Markdown (markdown, msXssProtect, msAddHeadingId)
 import Data.GhcLinks
+import Data.Aeson (withObject)
+import Data.Yaml
 
 data WebsiteContent = WebsiteContent
     { wcHomepage :: !Html
@@ -13,6 +16,7 @@ data WebsiteContent = WebsiteContent
     , wcInstall  :: !Html
     , wcOlderReleases :: !Html
     , wcGhcLinks :: !GhcLinks
+    , wcStackReleases :: ![StackRelease]
     }
 
 loadWebsiteContent :: FilePath -> IO WebsiteContent
@@ -23,6 +27,8 @@ loadWebsiteContent dir = do
     wcOlderReleases <- readHtml "older-releases.html" `catchIO`
                     \_ -> readMarkdown "older-releases.md"
     wcGhcLinks <- readGhcLinks $ dir </> "stackage-cli"
+    wcStackReleases <- decodeFileEither (dir </> "stack" </> "releases.yaml")
+        >>= either throwIO return
     return WebsiteContent {..}
   where
     readHtml fp = fmap (preEscapedToMarkup . decodeUtf8 :: ByteString -> Html)
@@ -32,3 +38,12 @@ loadWebsiteContent dir = do
                         , msAddHeadingId = True
                         })
                $ readFile $ dir </> fp
+
+data StackRelease = StackRelease
+    { srName :: !Text
+    , srPattern :: !Text
+    }
+instance FromJSON StackRelease where
+    parseJSON = withObject "StackRelease" $ \o -> StackRelease
+        <$> o .: "name"
+        <*> o .: "pattern"

Foundation.hs

@@ -28,6 +28,8 @@ data App = App
     , genIO :: MWC.GenIO
     , websiteContent :: GitRepo WebsiteContent
     , stackageDatabase :: IO StackageDatabase
+    , latestStackMatcher :: IO (Text -> Maybe Text)
+    -- ^ Give a pattern, get a URL
     }
 
 instance HasGenIO App where

config/routes

@@ -50,3 +50,6 @@
 !/feed/#LtsMajor LtsMajorFeedR GET
 /feed/lts LtsFeedR GET
 /feed/nightly NightlyFeedR GET
+
+/stack DownloadStackListR GET
+/stack/#Text DownloadStackR GET

stackage-server.cabal

@@ -49,6 +49,7 @@ library
                      Handler.Download
                      Handler.OldLinks
                      Handler.Feed
+                     Handler.DownloadStack
 
     if flag(dev) || flag(library-only)
         cpp-options:   -DDEVELOPMENT