diff --git a/Data/GhcLinks.hs b/Data/GhcLinks.hs new file mode 100644 index 0000000..99204aa --- /dev/null +++ b/Data/GhcLinks.hs @@ -0,0 +1,41 @@ +module Data.GhcLinks + ( GhcLinks(..) + , readGhcLinks + ) where + +import ClassyPrelude.Yesod +import Control.Monad.State.Strict (modify, execStateT) +import qualified Data.HashMap.Strict as HashMap +import Filesystem (readTextFile, isFile) + +import Types + + +newtype GhcLinks = GhcLinks + { ghcLinksMap :: HashMap (SupportedArch, GhcMajorVersion) Text } + -- ^ a map from (arch, ver) to yaml + +supportedArches :: [SupportedArch] +supportedArches = [minBound .. maxBound] + +supportedGhcMajorVersions :: [GhcMajorVersion] +supportedGhcMajorVersions = ["7.8"] + + +readGhcLinks :: FilePath -> IO GhcLinks +readGhcLinks dir = do + let opts = + [ (arch, ver) + | arch <- supportedArches + , ver <- supportedGhcMajorVersions + ] + hashMap <- flip execStateT HashMap.empty + $ forM_ opts $ \(arch, ver) -> do + let fileName = "ghc-" <> ver <> "-links.yaml" + let path = dir + fpFromText (toPathPiece arch) + fpFromText fileName + whenM (liftIO $ isFile path) $ do + text <- liftIO $ readTextFile path + modify (HashMap.insert (arch, ver) text) + return $ GhcLinks hashMap diff --git a/Data/WebsiteContent.hs b/Data/WebsiteContent.hs index 43e64a4..ed877bd 100644 --- a/Data/WebsiteContent.hs +++ b/Data/WebsiteContent.hs @@ -5,12 +5,14 @@ module Data.WebsiteContent import ClassyPrelude.Yesod import Text.Markdown (markdown, msXssProtect, msAddHeadingId) +import Data.GhcLinks data WebsiteContent = WebsiteContent { wcHomepage :: !Html , wcAuthors :: !Html , wcInstall :: !Html , wcOlderReleases :: !Html + , wcGhcLinks :: !GhcLinks } loadWebsiteContent :: FilePath -> IO WebsiteContent @@ -20,6 +22,7 @@ loadWebsiteContent dir = do wcInstall <- readMarkdown "install.md" wcOlderReleases <- readHtml "older-releases.html" `catchIO` \_ -> readMarkdown "older-releases.md" + wcGhcLinks <- readGhcLinks $ dir "stackage-cli" return WebsiteContent {..} where readHtml fp = fmap (preEscapedToMarkup . decodeUtf8 :: ByteString -> Html) diff --git a/Handler/Download.hs b/Handler/Download.hs index 770d609..e9fe7c4 100644 --- a/Handler/Download.hs +++ b/Handler/Download.hs @@ -2,10 +2,13 @@ module Handler.Download ( getDownloadR , getDownloadLtsSnapshotsJsonR , getGhcMajorVersionR + , getDownloadGhcLinksR ) where import Import import Data.Slug (SnapSlug) +import Data.GhcLinks +import Yesod.GitRepo (grContent) executableFor :: SupportedArch -> StackageExecutable executableFor Win32 = StackageWindowsExecutable @@ -13,9 +16,10 @@ executableFor Win64 = StackageWindowsExecutable executableFor _ = StackageUnixExecutable -- TODO: link to s3 -executableLink :: SupportedArch -> StackageExecutable -> Route App +executableLink :: SupportedArch -> StackageExecutable -> Text executableLink arch exe = - StaticR $ StaticRoute ["setup", toPathPiece arch, toPathPiece exe] [] + "https://s3.amazonaws.com/download.fpcomplete.com/stackage-cli/" + <> toPathPiece arch <> "/" <> toPathPiece exe downloadCandidates :: [(SupportedArch, StackageExecutable)] downloadCandidates = @@ -61,3 +65,15 @@ getGhcMajorVersionR :: SnapSlug -> Handler Text getGhcMajorVersionR slug = do snapshot <- runDB $ getBy404 $ UniqueSnapshot slug return $ ltsGhcMajorVersion $ entityVal snapshot + +getDownloadGhcLinksR :: SupportedArch -> Text -> Handler TypedContent +getDownloadGhcLinksR arch fileName = do + ver <- maybe notFound return + $ stripPrefix "ghc-" >=> stripSuffix "-links.yaml" + $ fileName + ghcLinks <- getYesod >>= fmap wcGhcLinks . liftIO . grContent . websiteContent + case lookup (arch, ver) (ghcLinksMap ghcLinks) of + Just text -> return $ TypedContent yamlMimeType $ toContent text + Nothing -> notFound + where + yamlMimeType = "text/yaml" diff --git a/Types.hs b/Types.hs index 74d1000..051c29e 100644 --- a/Types.hs +++ b/Types.hs @@ -2,6 +2,7 @@ module Types where import ClassyPrelude.Yesod import Data.BlobStore (ToPath (..), BackupToS3 (..)) +import Data.Hashable (hashUsing) import Text.Blaze (ToMarkup) import Database.Persist.Sql (PersistFieldSql (sqlType)) import qualified Data.Text as T @@ -117,6 +118,8 @@ instance PathPiece StackageExecutable where fromPathPiece "stackage-setup.exe" = Just StackageWindowsExecutable fromPathPiece _ = Nothing +type GhcMajorVersion = Text + data SupportedArch = Win32 | Win64 @@ -126,6 +129,9 @@ data SupportedArch | Mac64 deriving (Enum, Bounded, Show, Read, Eq) +instance Hashable SupportedArch where + hashWithSalt = hashUsing fromEnum + instance PathPiece SupportedArch where toPathPiece Win32 = "win32" toPathPiece Win64 = "win64" diff --git a/config/routes b/config/routes index 371e01b..64bb56f 100644 --- a/config/routes +++ b/config/routes @@ -61,3 +61,4 @@ /download DownloadR GET /download/lts-snapshots.json DownloadLtsSnapshotsJsonR GET +/download/#SupportedArch/#Text DownloadGhcLinksR GET diff --git a/stackage-server.cabal b/stackage-server.cabal index 381e758..34495eb 100644 --- a/stackage-server.cabal +++ b/stackage-server.cabal @@ -23,6 +23,7 @@ library Data.Slug Data.Tag Data.BlobStore + Data.GhcLinks Data.Hackage Data.Hackage.DeprecationInfo Data.WebsiteContent @@ -145,6 +146,7 @@ library , yesod-static >= 1.2 , zlib , unordered-containers + , hashable -- Avoid https://github.com/haskell/cabal/issues/1202 , Cabal >= 1.18 , lifted-base diff --git a/templates/download.hamlet b/templates/download.hamlet index dc0a599..1d0e2c8 100644 --- a/templates/download.hamlet +++ b/templates/download.hamlet @@ -9,13 +9,13 @@ $forall (arch, exe) <- downloadCandidates $if currentlySupported arch
  • #{toPathPiece arch}: - + #{toPathPiece exe}

    What is stackage-setup?

    The stackage-setup executable is an easy way to download and set up the basic executables needed for developing Haskell. -

    You can find these executables in: +

    After running stackage-setup, You can find these executables in: ~/.stackage/environment/$group/$group-$version/bin/

    For example, ghc, ghc-pkg, haddock, etc for ghc-7.8.4 are installed here: ~/.stackage/environment/ghc/ghc-7.8.4/bin/