stackage-server/src/Handler/Download.hs
2020-02-12 02:10:14 +03:00

48 lines
1.7 KiB
Haskell

{-# LANGUAGE NoImplicitPrelude #-}
module Handler.Download
( getDownloadR
, getDownloadSnapshotsJsonR
, getDownloadLtsSnapshotsJsonR
, getGhcMajorVersionR
, getDownloadGhcLinksR
) where
import RIO (textDisplay)
import Import
import Data.GhcLinks
import Yesod.GitRepo (grContent)
import Stackage.Database
getDownloadR :: Handler Html
getDownloadR = track "Hoogle.Download.getDownloadR" $
redirectWith status301 InstallR
getDownloadSnapshotsJsonR :: Handler Value
getDownloadSnapshotsJsonR = track "Hoogle.Download.getDownloadSnapshotsJsonR"
getDownloadLtsSnapshotsJsonR
getDownloadLtsSnapshotsJsonR :: Handler Value
getDownloadLtsSnapshotsJsonR = track "Hoogle.Download.getDownloadLtsSnapshotsJsonR" snapshotsJSON
-- Print the ghc major version for the given snapshot.
ghcMajorVersionText :: Snapshot -> Text
ghcMajorVersionText = textDisplay . keepMajorVersion . ghcVersion . snapshotCompiler
getGhcMajorVersionR :: SnapName -> Handler Text
getGhcMajorVersionR name = track "Hoogle.Download.getGhcMajorVersionR" $ do
snapshot <- lookupSnapshot name >>= maybe notFound return
return $ ghcMajorVersionText $ entityVal snapshot
getDownloadGhcLinksR :: SupportedArch -> Text -> Handler TypedContent
getDownloadGhcLinksR arch fName =
track "Hoogle.Download.getDownloadGhcLinksR" $ do
ver <-
maybe notFound return $
stripPrefix "ghc-" >=> stripSuffix "-links.yaml" >=> ghcMajorVersionFromText $ fName
ghcLinks <- getYesod >>= fmap wcGhcLinks . liftIO . grContent . appWebsiteContent
case lookup (arch, ver) (ghcLinksMap ghcLinks) of
Just text -> return $ TypedContent yamlMimeType $ toContent text
Nothing -> notFound
where
yamlMimeType = "text/yaml"