Reorganize hosting of stackage-setup binary and yaml

This commit is contained in:
Dan Burton 2015-04-24 13:43:52 -07:00
parent 4d02fc7bdd
commit 34d1d628e8
7 changed files with 73 additions and 4 deletions

41
Data/GhcLinks.hs Normal file
View File

@ -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

View File

@ -5,12 +5,14 @@ module Data.WebsiteContent
import ClassyPrelude.Yesod import ClassyPrelude.Yesod
import Text.Markdown (markdown, msXssProtect, msAddHeadingId) import Text.Markdown (markdown, msXssProtect, msAddHeadingId)
import Data.GhcLinks
data WebsiteContent = WebsiteContent data WebsiteContent = WebsiteContent
{ wcHomepage :: !Html { wcHomepage :: !Html
, wcAuthors :: !Html , wcAuthors :: !Html
, wcInstall :: !Html , wcInstall :: !Html
, wcOlderReleases :: !Html , wcOlderReleases :: !Html
, wcGhcLinks :: !GhcLinks
} }
loadWebsiteContent :: FilePath -> IO WebsiteContent loadWebsiteContent :: FilePath -> IO WebsiteContent
@ -20,6 +22,7 @@ loadWebsiteContent dir = do
wcInstall <- readMarkdown "install.md" wcInstall <- readMarkdown "install.md"
wcOlderReleases <- readHtml "older-releases.html" `catchIO` wcOlderReleases <- readHtml "older-releases.html" `catchIO`
\_ -> readMarkdown "older-releases.md" \_ -> readMarkdown "older-releases.md"
wcGhcLinks <- readGhcLinks $ dir </> "stackage-cli"
return WebsiteContent {..} return WebsiteContent {..}
where where
readHtml fp = fmap (preEscapedToMarkup . decodeUtf8 :: ByteString -> Html) readHtml fp = fmap (preEscapedToMarkup . decodeUtf8 :: ByteString -> Html)

View File

@ -2,10 +2,13 @@ module Handler.Download
( getDownloadR ( getDownloadR
, getDownloadLtsSnapshotsJsonR , getDownloadLtsSnapshotsJsonR
, getGhcMajorVersionR , getGhcMajorVersionR
, getDownloadGhcLinksR
) where ) where
import Import import Import
import Data.Slug (SnapSlug) import Data.Slug (SnapSlug)
import Data.GhcLinks
import Yesod.GitRepo (grContent)
executableFor :: SupportedArch -> StackageExecutable executableFor :: SupportedArch -> StackageExecutable
executableFor Win32 = StackageWindowsExecutable executableFor Win32 = StackageWindowsExecutable
@ -13,9 +16,10 @@ executableFor Win64 = StackageWindowsExecutable
executableFor _ = StackageUnixExecutable executableFor _ = StackageUnixExecutable
-- TODO: link to s3 -- TODO: link to s3
executableLink :: SupportedArch -> StackageExecutable -> Route App executableLink :: SupportedArch -> StackageExecutable -> Text
executableLink arch exe = 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 :: [(SupportedArch, StackageExecutable)]
downloadCandidates = downloadCandidates =
@ -61,3 +65,15 @@ getGhcMajorVersionR :: SnapSlug -> Handler Text
getGhcMajorVersionR slug = do getGhcMajorVersionR slug = do
snapshot <- runDB $ getBy404 $ UniqueSnapshot slug snapshot <- runDB $ getBy404 $ UniqueSnapshot slug
return $ ltsGhcMajorVersion $ entityVal snapshot 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"

View File

@ -2,6 +2,7 @@ module Types where
import ClassyPrelude.Yesod import ClassyPrelude.Yesod
import Data.BlobStore (ToPath (..), BackupToS3 (..)) import Data.BlobStore (ToPath (..), BackupToS3 (..))
import Data.Hashable (hashUsing)
import Text.Blaze (ToMarkup) import Text.Blaze (ToMarkup)
import Database.Persist.Sql (PersistFieldSql (sqlType)) import Database.Persist.Sql (PersistFieldSql (sqlType))
import qualified Data.Text as T import qualified Data.Text as T
@ -117,6 +118,8 @@ instance PathPiece StackageExecutable where
fromPathPiece "stackage-setup.exe" = Just StackageWindowsExecutable fromPathPiece "stackage-setup.exe" = Just StackageWindowsExecutable
fromPathPiece _ = Nothing fromPathPiece _ = Nothing
type GhcMajorVersion = Text
data SupportedArch data SupportedArch
= Win32 = Win32
| Win64 | Win64
@ -126,6 +129,9 @@ data SupportedArch
| Mac64 | Mac64
deriving (Enum, Bounded, Show, Read, Eq) deriving (Enum, Bounded, Show, Read, Eq)
instance Hashable SupportedArch where
hashWithSalt = hashUsing fromEnum
instance PathPiece SupportedArch where instance PathPiece SupportedArch where
toPathPiece Win32 = "win32" toPathPiece Win32 = "win32"
toPathPiece Win64 = "win64" toPathPiece Win64 = "win64"

View File

@ -61,3 +61,4 @@
/download DownloadR GET /download DownloadR GET
/download/lts-snapshots.json DownloadLtsSnapshotsJsonR GET /download/lts-snapshots.json DownloadLtsSnapshotsJsonR GET
/download/#SupportedArch/#Text DownloadGhcLinksR GET

View File

@ -23,6 +23,7 @@ library
Data.Slug Data.Slug
Data.Tag Data.Tag
Data.BlobStore Data.BlobStore
Data.GhcLinks
Data.Hackage Data.Hackage
Data.Hackage.DeprecationInfo Data.Hackage.DeprecationInfo
Data.WebsiteContent Data.WebsiteContent
@ -145,6 +146,7 @@ library
, yesod-static >= 1.2 , yesod-static >= 1.2
, zlib , zlib
, unordered-containers , unordered-containers
, hashable
-- Avoid https://github.com/haskell/cabal/issues/1202 -- Avoid https://github.com/haskell/cabal/issues/1202
, Cabal >= 1.18 , Cabal >= 1.18
, lifted-base , lifted-base

View File

@ -9,13 +9,13 @@ $forall (arch, exe) <- downloadCandidates
$if currentlySupported arch $if currentlySupported arch
<li> <li>
#{toPathPiece arch}: #{toPathPiece arch}:
<a href=@{executableLink arch exe}> <a href=#{executableLink arch exe}>
#{toPathPiece exe} #{toPathPiece exe}
<h1>What is stackage-setup? <h1>What is stackage-setup?
<p>The stackage-setup executable is an easy way to download and set up the basic executables needed for developing Haskell. <p>The stackage-setup executable is an easy way to download and set up the basic executables needed for developing Haskell.
<p>You can find these executables in: <p>After running stackage-setup, You can find these executables in:
<code>~/.stackage/environment/$group/$group-$version/bin/ <code>~/.stackage/environment/$group/$group-$version/bin/
<p>For example, ghc, ghc-pkg, haddock, etc for ghc-7.8.4 are installed here: <p>For example, ghc, ghc-pkg, haddock, etc for ghc-7.8.4 are installed here:
<code>~/.stackage/environment/ghc/ghc-7.8.4/bin/ <code>~/.stackage/environment/ghc/ghc-7.8.4/bin/