diff --git a/stack/global-hints.yaml b/stack/global-hints.yaml index 33e459e..acfd817 100644 --- a/stack/global-hints.yaml +++ b/stack/global-hints.yaml @@ -3,6 +3,45 @@ # This file auto-generated by update-global-hints.hs. # Please ensure this is updated when a new version of GHC is released. +ghc-9.4.0.20220721: + exceptions: 0.10.5 + ghc: 9.4.0.20220721 + bytestring: 0.11.3.1 + system-cxx-std-lib: '1.0' + unix: 2.7.3 + haskeline: 0.8.2 + stm: 2.5.1.0 + Cabal: 3.8.0.20220526 + base: 4.17.0.0 + time: 1.12.2 + xhtml: 3000.2.2.1 + text: '2.0' + hpc: 0.6.1.0 + ghc-bignum: '1.3' + filepath: 1.4.2.2 + process: 1.6.14.0 + parsec: 3.1.15.0 + ghc-compact: 0.1.0.0 + array: 0.5.4.0 + Win32: 2.12.0.0 + integer-gmp: '1.1' + Cabal-syntax: 3.8.0.20220526 + containers: 0.6.5.1 + libiserv: 9.4.0.20220721 + ghc-boot: 9.4.0.20220721 + binary: 0.8.9.0 + ghc-prim: 0.9.0 + mtl: 2.2.2 + ghc-heap: 9.4.0.20220721 + ghci: 9.4.0.20220721 + rts: 1.0.2 + terminfo: 0.4.1.5 + transformers: 0.5.6.2 + deepseq: 1.4.8.0 + ghc-boot-th: 9.4.0.20220721 + pretty: 1.1.3.6 + template-haskell: 2.19.0.0 + directory: 1.3.7.1 ghc-8.4.2: ghc: 8.4.2 bytestring: 0.10.8.2 @@ -1034,7 +1073,6 @@ ghc-9.2.4: parsec: 3.1.15.0 ghc-compact: 0.1.0.0 array: 0.5.4.0 - Win32: 2.12.0.1 integer-gmp: '1.1' containers: 0.6.5.1 libiserv: 9.2.4 @@ -1148,42 +1186,3 @@ ghc-7.10.1: pretty: 1.1.2.0 template-haskell: 2.10.0.0 directory: 1.2.2.0 -ghc-9.4.0.20220721: - Cabal-syntax: 3.8.0.20220526 - Cabal: 3.8.0.20220526 - Win32: 2.12.0.0 - array: 0.5.4.0 - base: 4.17.0.0 - binary: 0.8.9.0 - bytestring: 0.11.3.1 - containers: 0.6.5.1 - deepseq: 1.4.8.0 - directory: 1.3.7.1 - exceptions: 0.10.5 - filepath: 1.4.2.2 - ghc-bignum: '1.3' - ghc-boot-th: 9.4.0.20220721 - ghc-boot: 9.4.0.20220721 - ghc-compact: 0.1.0.0 - ghc-heap: 9.4.0.20220721 - ghc-prim: 0.9.0 - ghc: 9.4.0.20220721 - ghci: 9.4.0.20220721 - haskeline: 0.8.2 - hpc: 0.6.1.0 - integer-gmp: '1.1' - libiserv: 9.4.0.20220721 - mtl: 2.2.2 - parsec: 3.1.15.0 - pretty: 1.1.3.6 - process: 1.6.14.0 - rts: 1.0.2 - stm: 2.5.1.0 - system-cxx-std-lib: '1.0' - template-haskell: 2.19.0.0 - terminfo: 0.4.1.5 - text: '2.0' - time: 1.12.2 - transformers: 0.5.6.2 - unix: 2.7.3 - xhtml: 3000.2.2.1 diff --git a/stack/update-global-hints.hs b/stack/update-global-hints.hs index b67d539..503ba33 100755 --- a/stack/update-global-hints.hs +++ b/stack/update-global-hints.hs @@ -2,19 +2,21 @@ -- stack --resolver lts-18.5 script {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS -Wall #-} import Data.Yaml import RIO +import Data.String.Conversions +import Data.List ((!!)) +import Data.Maybe (fromJust) import qualified RIO.Map as Map import qualified RIO.Text as T import System.Environment (getArgs) import RIO.Process +import qualified Data.Text as T import Distribution.Types.PackageId import qualified RIO.ByteString.Lazy as BL import qualified Distribution.Text as DT (simpleParse, display) -import Text.HTML.DOM (parseBSChunks) -import Text.XML.Cursor -import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Network.HTTP.Simple comment :: ByteString @@ -29,6 +31,7 @@ type PackageId' = Text type PackageVersion = Text type GlobalHintsFragment = Map GhcVer (Map PackageId' PackageVersion) +globalHintsFile :: FilePath globalHintsFile = "global-hints.yaml" readGlobalHintsFile :: RIO SimpleApp GlobalHintsFragment @@ -80,29 +83,22 @@ scrapeGhcReleaseNotes vers = do pairs <- for vers myScrapeURL pure $ Map.fromList pairs where - url ver = T.unpack $ mconcat - [ "https://downloads.haskell.org/~ghc/" - , ver' - , "/docs/html/users_guide/" - , ver' - , "-notes.html" - ] where ver' = fromMaybe ver (T.stripPrefix "ghc-" ver) + url _ = "https://gitlab.haskell.org/bgamari/ghc-utils/-/raw/master/library-versions/pkg_versions.txt" myScrapeURL ghcVer = do let url' = url ghcVer req <- parseRequest url' response <- httpBS req - let doc = parseBSChunks [getResponseBody response] - cursor = fromDocument doc - rows = cursor $// attributeIs "id" "included-libraries" &// element "tbody" &/ element "tr" - pairs <- traverse toPair rows - if null pairs - then error $ "Unable to parse HTML at " ++ url' - else pure (ghcVer, Map.fromList pairs) + let body = getResponseBody response + let ghcVerNo = fromJust $ T.stripPrefix "ghc-" ghcVer + pure (ghcVer, Map.fromList $ parsePkgVersions ghcVerNo body) - toPair row = - case map (\td -> fold $ td $// content) $ row $/ element "td" of - (pkg:ver:_) -> pure (pkg, ver) - _ -> error $ "Could not parse row " ++ show row + parsePkgVersions :: Text -> ByteString -> [(Text, Text)] + parsePkgVersions ghcVerNo = concatMap fun . T.lines . cs + where + fun :: Text -> [(Text, Text)] + fun t = case T.stripPrefix (ghcVerNo <> " ") t of + Nothing -> [] + Just rest -> map (\e -> let pv = T.splitOn "/" e in if length pv /= 2 then error (show e) else (pv !! 0, pv !! 1)) $ T.splitOn " " $ T.dropWhile (== ' ') rest globalHintsFragmentProviders :: [GhcVer] -> [RIO SimpleApp GlobalHintsFragment] globalHintsFragmentProviders vers =