Implement missing Handler.Download functionality

Handler/Download.hs

@@ -10,6 +10,7 @@ import Import
 import Data.GhcLinks
 import Yesod.GitRepo (grContent)
 import Stackage.Database
+import qualified Data.Text as T
 
 executableFor :: SupportedArch -> StackageExecutable
 executableFor Win32 = StackageWindowsExecutable
@@ -36,30 +37,13 @@ getDownloadR = defaultLayout $ do
     setTitle "Download"
     $(widgetFile "download")
 
-{- FIXME
-ltsMajorVersions :: YesodDB App [Lts]
-ltsMajorVersions =
-        (dropOldMinors . map entityVal)
-    <$> selectList [] [Desc LtsMajor, Desc LtsMinor]
-
-dropOldMinors :: [Lts] -> [Lts]
-dropOldMinors [] = []
-dropOldMinors (l@(Lts x _ _):rest) =
-    l : dropOldMinors (dropWhile sameMinor rest)
-  where
-    sameMinor (Lts y _ _) = x == y
--}
-
 getDownloadSnapshotsJsonR :: Handler Value
 getDownloadSnapshotsJsonR = getDownloadLtsSnapshotsJsonR
 
 getDownloadLtsSnapshotsJsonR :: Handler Value
 getDownloadLtsSnapshotsJsonR = do
-    error "getDownloadLtsSnapshotsJsonR"
-    {-
-    (mlatestNightly, ltses) <- runDB $ (,)
-        <$> getLatestNightly
-        <*> ltsMajorVersions
+    mlatestNightly <- newestNightly
+    ltses <- ltsMajorVersions
     let lts = case ltses of
             [] -> []
             majorVersions@(latest:_) ->
@@ -70,31 +54,25 @@ getDownloadLtsSnapshotsJsonR = do
             Just n -> (("nightly" .= printNightly n):)
     return $ object $ nightly lts
   where
-    toObj lts@(Lts major _ _) =
+    toObj lts@(major, _) =
         pack ("lts-" ++ show major) .= printLts lts
-    printLts (Lts major minor _) =
+    printLts (major, minor) =
         "lts-" ++ show major ++ "." ++ show minor
 
-    printNightly (Entity _ (Nightly day _ _)) =
-        "nightly-" ++ tshow day
-    getLatestNightly = selectFirst [] [Desc NightlyDay]
+    printNightly day = "nightly-" ++ tshow day
 
 -- Print the ghc major version for the given snapshot.
--- Assumes 7.8 if unspecified
-ghcMajorVersionText :: Stackage -> Text
-ghcMajorVersionText snapshot
-  = ghcMajorVersionToText
-  $ fromMaybe (GhcMajorVersion 7 8)
-  $ stackageGhcMajorVersion snapshot
-    -}
+ghcMajorVersionText :: Snapshot -> Text
+ghcMajorVersionText =
+    getMajorVersion . snapshotGhc
+  where
+    getMajorVersion :: Text -> Text
+    getMajorVersion = intercalate "." . take 2 . T.splitOn "."
 
 getGhcMajorVersionR :: SnapName -> Handler Text
-getGhcMajorVersionR _slug = do
-  error "getGhcMajorVersionR"
-  {-
-  snapshot <- runDB $ getBy404 $ UniqueSnapshot slug
-  return $ ghcMajorVersionText $ entityVal snapshot
-  -}
+getGhcMajorVersionR name = do
+    snapshot <- lookupSnapshot name >>= maybe notFound return
+    return $ ghcMajorVersionText $ entityVal snapshot
 
 getDownloadGhcLinksR :: SupportedArch -> Text -> Handler TypedContent
 getDownloadGhcLinksR arch fileName = do

Stackage/Database.hs

@@ -5,6 +5,7 @@ module Stackage.Database
     , Snapshot (..)
     , newestLTS
     , newestLTSMajor
+    , ltsMajorVersions
     , newestNightly
     , lookupSnapshot
     , snapshotTitle
@@ -401,6 +402,19 @@ newestLTSMajor :: GetStackageDatabase m => Int -> m (Maybe Int)
 newestLTSMajor x =
     run $ liftM (fmap $ ltsMinor . entityVal) $ selectFirst [LtsMajor ==. x] [Desc LtsMinor]
 
+ltsMajorVersions :: GetStackageDatabase m => m [(Int, Int)]
+ltsMajorVersions =
+    run $ liftM (dropOldMinors . map (toPair . entityVal))
+        $ selectList [] [Desc LtsMajor, Desc LtsMinor]
+  where
+    toPair (Lts _ x y) = (x, y)
+
+    dropOldMinors [] = []
+    dropOldMinors (l@(x, _):rest) =
+        l : dropOldMinors (dropWhile sameMinor rest)
+      where
+        sameMinor (y, _) = x == y
+
 newestNightly :: GetStackageDatabase m => m (Maybe Day)
 newestNightly =
     run $ liftM (fmap $ nightlyDay . entityVal) $ selectFirst [] [Desc NightlyDay]