Generating stack's setup-info for ghc-8.4-alpha3

Main.hs

#!/usr/bin/env stack
{- stack
  script
  --resolver lts-10.2
  --package bytestring
  --package http-conduit
-}

-- usage: ./Main.hs
-- modify the baseUrl and ghcDateVersion to taste

{-# LANGUAGE LambdaCase #-}
module Main where

import Data.Semigroup ((<>))

import qualified Data.ByteString.Char8 as C8
import qualified Data.Foldable as F
import qualified Network.HTTP.Simple as HTTP
import qualified System.IO as Sys


baseUrl :: String
baseUrl = "https://downloads.haskell.org/~ghc/8.4.1-alpha3/"

ghcDateVersion :: String
ghcDateVersion = "ghc-8.4.0.20180204"


shouldSkipFile :: String -> Bool
shouldSkipFile "src" = True
shouldSkipFile "testsuite" = True
shouldSkipFile "windows-extra-src" = True
shouldSkipFile "x86_64-deb8-linux-dwarf" = True -- not sure what to do with this
shouldSkipFile _ = False

-- TODO: add more
systemNameMapping :: String -> Maybe String
systemNameMapping "i386-deb8-linux" = Just "linux32-nopie"
systemNameMapping "i386-unknown-mingw32" = Just "windows32"
systemNameMapping "i386-unknown-mingw32-win10" = Just "windows32"
systemNameMapping "x86_64-apple-darwin" = Just "macosx"
systemNameMapping "x86_64-deb8-linux" = Just "linux64-nopie"
systemNameMapping "x86_64-unknown-mingw32" = Just "windows64"
systemNameMapping "x86_64-unknown-mingw32-win10" = Just "windows64"
systemNameMapping "x86_64-fedora27-linux" = Just "linux64-tinfo-nopie"
systemNameMapping "x86_64-unknown-linux" = Just "linux64"
systemNameMapping _ = Nothing

-- TODO: generalize
stripSurroundings :: String -> String
stripSurroundings =
    reverse
  . drop (length ".tar.xz")
  . reverse
  . drop (length $ "./" <> ghcDateVersion <> "-")

err :: String -> IO ()
err s = Sys.hPutStrLn Sys.stderr ("***** " <> s)

printSection :: String -> String -> String -> IO ()
printSection target path sha256 = do
  putStrLn $ "    " <> target <> ":"
  putStrLn $ "      " <> (drop (length "ghc-") ghcDateVersion) <> ":"
  putStrLn $ "        url: " <> baseUrl <> drop (length "./") path
  putStrLn $ "        sha256: " <> sha256


main :: IO ()
main = do
  req <- HTTP.parseRequest (baseUrl <> "/SHA256SUMS")
  res <- HTTP.httpBS req

  putStrLn "setup-info:"
  putStrLn "  ghc:"
  let strBody = C8.unpack $ HTTP.getResponseBody $ res
  F.for_ (lines strBody) $ \line -> case words line of
    [sha256, path] -> do
      let file = stripSurroundings path
      if (not $ shouldSkipFile file)
        then
        case systemNameMapping file of
          -- I don't really understand this special case
          -- but it seems like these two fedora cases use the same tarball
          Just "linux64-tinfo-nopie" -> do
            printSection "linux64-tinfo" path sha256
            printSection "linux64-tinfo-nopie" path sha256
          Just target -> do
            printSection target path sha256
          Nothing -> do
            err $ "Failed system name lookup: " <> file
        else return ()
    _ -> err $ "Unexpected line: " <> line

  putStrLn ""
  putStrLn $ "resolver: " <> ghcDateVersion
  putStrLn $ "compiler: " <> ghcDateVersion
  putStrLn "compiler-check: match-exact"
  putStrLn "packages: []"