{-# 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"