Last active
January 23, 2018 18:48
-
-
Save pbrisbin/5c59d1e1c177399587cb074198804202 to your computer and use it in GitHub Desktop.
LTS resolvers by GHC version
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
GHC 7.8.3 (base-4.7.0.1): lts-0.0 -> lts-0.7 | |
GHC 7.8.4 (base-4.7.0.2): lts-1.0 -> lts-2.22 | |
GHC 7.10.2 (base-4.8.1.0): lts-3.0 -> lts-3.22 | |
GHC 7.10.3 (base-4.8.2.0): lts-4.0 -> lts-6.35 | |
GHC 8.0.1 (base-4.9.0.0): lts-7.0 -> lts-7.24 | |
GHC 8.0.2 (base-4.9.1.0): lts-8.0 -> lts-9.21 | |
GHC 8.2.2 (base-4.10.1.0): lts-10.0 -> lts-10.3 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#!/usr/bin/env stack | |
{- stack | |
--resolver lts-10.3 | |
--install-ghc | |
runghc | |
--package aeson | |
--package containers | |
--package process | |
--package text | |
--package vector | |
-- -Wall -Werror | |
-} | |
{-# LANGUAGE OverloadedStrings #-} | |
module Main (main) where | |
import Control.Monad (forM_, void) | |
import Data.Aeson | |
import Data.Function (on) | |
import Data.List (sortBy, groupBy) | |
import Data.Monoid ((<>)) | |
import Data.Text (Text) | |
import Data.Version | |
import System.Process (readProcess) | |
import Text.ParserCombinators.ReadP | |
import qualified Data.ByteString.Lazy.Char8 as BSL8 | |
import qualified Data.Map as M | |
import qualified Data.Text as T | |
import qualified Data.Vector as V | |
-- | Specifically an LTS snapshot, with version info parsed | |
data LTSSnapshot = LTSSnapshot | |
{ sLTSVersion :: Version | |
, sGHCVersion :: Version | |
} | |
-- | Any snapshot, with opaque resolver and title values | |
data Snapshot = Snapshot | |
{ sResolver :: Text | |
, sTitle :: Text | |
} | |
instance FromJSON Snapshot where | |
parseJSON = withArray "Snapshot" $ \arr -> Snapshot | |
<$> parseJSON (arr V.! 0) | |
<*> parseJSON (arr V.! 1) | |
newtype Snapshots = Snapshots { unSnapshots :: [Snapshot] } | |
instance FromJSON Snapshots where | |
parseJSON = withObject "Snapshots" $ \o -> do | |
elems <- o .: "snapshots" | |
Snapshots . concat <$> mapM parseJSON (elems :: V.Vector Value) | |
main :: IO () | |
main = do | |
grouped <- groupLTSSnapshots <$> allSnapshots | |
forM_ grouped $ \group -> do | |
let s1 = head group | |
s2 = last group | |
gv = sGHCVersion s1 | |
Just bv = ghcToBaseVersion gv | |
putStrLn $ mconcat | |
[ "GHC ", showVersion gv, " (base-", showVersion bv, "):" | |
, " lts-", showVersion $ sLTSVersion s1, " ->" | |
, " lts-", showVersion $ sLTSVersion s2 | |
] | |
groupLTSSnapshots :: [Snapshot] -> [[LTSSnapshot]] | |
groupLTSSnapshots = | |
groupBy ((==) `on` sGHCVersion) | |
. sortBy (compare `on` sLTSVersion) | |
. toLTSSnapshots | |
allSnapshots :: IO [Snapshot] | |
allSnapshots = go 1 [] | |
where | |
go :: Int -> [Snapshot] -> IO [Snapshot] | |
go page acc = do | |
snapshots <- either (error . show) unSnapshots <$> curlPage page | |
if null snapshots | |
then pure acc | |
else go (page + 1) $ acc <> snapshots | |
-- Forgive me | |
curlPage page = eitherDecode . BSL8.pack <$> readProcess "curl" | |
[ "--silent" | |
, "-H", "Accept: application/json" | |
, "https://www.stackage.org/snapshots?page=" <> show page | |
] "" | |
toLTSSnapshots :: [Snapshot] -> [LTSSnapshot] | |
toLTSSnapshots = map toLTSSnapshot . filter (("lts-" `T.isPrefixOf`) . sResolver) | |
-- Only call this if pre-filtered. We want to blow up if we filter incorrectly | |
toLTSSnapshot :: Snapshot -> LTSSnapshot | |
toLTSSnapshot = runReadP parseLTS . sTitle | |
where | |
runReadP p = fst . head . readP_to_S p . T.unpack | |
parseLTS = do | |
void $ string "LTS Haskell " | |
LTSSnapshot | |
<$> (parseVersion <* string " (ghc-") | |
<*> (parseVersion <* string ")" <* eof) | |
ghcToBaseVersion :: Version -> Maybe Version | |
ghcToBaseVersion v = M.lookup v baseVersions | |
where | |
-- https://wiki.haskell.org/Base_package | |
baseVersions = M.fromList | |
[ (makeVersion [6, 10, 1], makeVersion [4, 0, 0, 0]) | |
, (makeVersion [6, 10, 2], makeVersion [4, 1, 0, 0]) | |
, (makeVersion [6, 12, 1], makeVersion [4, 2, 0, 0]) | |
, (makeVersion [6, 12, 2], makeVersion [4, 2, 0, 1]) | |
, (makeVersion [6, 12, 3], makeVersion [4, 2, 0, 2]) | |
, (makeVersion [7, 0, 1], makeVersion [4, 3, 0, 0]) | |
, (makeVersion [7, 0, 2], makeVersion [4, 3, 1, 0]) | |
, (makeVersion [7, 2, 1], makeVersion [4, 4, 0, 0]) | |
, (makeVersion [7, 2, 2], makeVersion [4, 4, 1, 0]) | |
, (makeVersion [7, 4, 1], makeVersion [4, 5, 0, 0]) | |
, (makeVersion [7, 4, 2], makeVersion [4, 5, 1, 0]) | |
, (makeVersion [7, 6, 1], makeVersion [4, 6, 0, 0]) | |
, (makeVersion [7, 6, 2], makeVersion [4, 6, 0, 1]) | |
, (makeVersion [7, 8, 1], makeVersion [4, 7, 0, 0]) | |
, (makeVersion [7, 8, 3], makeVersion [4, 7, 0, 1]) | |
, (makeVersion [7, 8, 4], makeVersion [4, 7, 0, 2]) | |
, (makeVersion [7, 10, 1], makeVersion [4, 8, 0, 0]) | |
, (makeVersion [7, 10, 2], makeVersion [4, 8, 1, 0]) | |
, (makeVersion [7, 10, 3], makeVersion [4, 8, 2, 0]) | |
, (makeVersion [8, 0, 1], makeVersion [4, 9, 0, 0]) | |
, (makeVersion [8, 0, 2], makeVersion [4, 9, 1, 0]) | |
, (makeVersion [8, 2, 1], makeVersion [4, 10, 0, 0]) | |
, (makeVersion [8, 2, 2], makeVersion [4, 10, 1, 0]) | |
] | |
-- vim: ft=haskell |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment