From bef289a8c33cb82e5c577d79cd68b694c4cac753 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@fpcomplete.com>
Date: Thu, 15 Oct 2015 04:20:52 +0000
Subject: [PATCH] Download links for latest Stack (fixes
 commercialhaskell/stack#532)

---
 Application.hs         |  9 +++++++++
 Data/WebsiteContent.hs | 15 +++++++++++++++
 Foundation.hs          |  2 ++
 config/routes          |  3 +++
 stackage-server.cabal  |  1 +
 5 files changed, 30 insertions(+)

diff --git a/Application.hs b/Application.hs
index 1bf3ab4..102f53e 100644
--- a/Application.hs
+++ b/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
diff --git a/Data/WebsiteContent.hs b/Data/WebsiteContent.hs
index ed877bd..f7c6ab4 100644
--- a/Data/WebsiteContent.hs
+++ b/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"
diff --git a/Foundation.hs b/Foundation.hs
index d4e59b3..2404fc1 100644
--- a/Foundation.hs
+++ b/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
diff --git a/config/routes b/config/routes
index 5bd3315..8815f4f 100644
--- a/config/routes
+++ b/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
diff --git a/stackage-server.cabal b/stackage-server.cabal
index 6b80d75..4242295 100644
--- a/stackage-server.cabal
+++ b/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