[Git][ghc/ghc][wip/boot-lib-testing] 2 commits: check-submodules: initial commit
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Dec 20 23:34:48 UTC 2024
Ben Gamari pushed to branch wip/boot-lib-testing at Glasgow Haskell Compiler / GHC
Commits:
d9fcfc05 by Ben Gamari at 2024-12-20T18:24:57-05:00
check-submodules: initial commit
- - - - -
eae74661 by Ben Gamari at 2024-12-20T18:34:24-05:00
gitlab-ci: Add boot library linting steps
- - - - -
14 changed files:
- .gitlab-ci.yml
- + utils/check-submodules/LICENSE
- + utils/check-submodules/README.mkd
- + utils/check-submodules/app/Main.hs
- + utils/check-submodules/check-submodules.cabal
- + utils/check-submodules/flake.lock
- + utils/check-submodules/flake.nix
- + utils/check-submodules/hie.yaml
- + utils/check-submodules/src/CheckTags.hs
- + utils/check-submodules/src/CheckVersions.hs
- + utils/check-submodules/src/Git.hs
- + utils/check-submodules/src/Hackage.hs
- + utils/check-submodules/src/Package.hs
- + utils/check-submodules/src/Packages.hs
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -205,6 +205,23 @@ not-interruptible:
- if: $NIGHTLY
when: always
+.nix:
+ image: nixos/nix:2.25.2
+ before_script:
+ - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf
+ # Note [Nix-in-Docker]
+ # ~~~~~~~~~~~~~~~~~~~~
+ # The nixos/nix default config is max-jobs=1 and cores=$(logical
+ # cores num) which doesn't play nice with our $CPUS convention. We
+ # fix it before invoking any nix build to avoid oversubscribing
+ # while allowing a reasonable degree of parallelism.
+ # FIXME: Disabling build-users-group=nixbld is a workaround for a Nix-in-Docker issue. See
+ # https://gitlab.haskell.org/ghc/head.hackage/-/issues/38#note_560487 for
+ # discussion.
+ - echo "cores = $CPUS" >> /etc/nix/nix.conf
+ - echo "max-jobs = $CPUS" >> /etc/nix/nix.conf
+ - nix run nixpkgs#gnused -- -i -e 's/ nixbld//' /etc/nix/nix.conf
+
############################################################
# Validate jobs
@@ -255,6 +272,24 @@ typecheck-testsuite:
- mypy testsuite/driver/runtests.py
dependencies: []
+lint-boot-tags:
+ extends: [.lint, .nix]
+ script:
+ - nix run utils/check-submodules# -- check-tags
+ rules:
+ - if: $RELEASE_JOB
+ allow_failure: false
+ - allow_failure: true
+
+lint-boot-versions:
+ extends: [.lint, .nix]
+ script:
+ - nix run utils/check-submodules# -- check-versions
+ rules:
+ - if: $RELEASE_JOB
+ allow_failure: false
+ - allow_failure: true
+
# We allow the submodule checker to fail when run on merge requests (to
# accommodate, e.g., haddock changes not yet upstream) but not on `master` or
# Marge jobs.
@@ -292,26 +327,11 @@ lint-author:
- *drafts-can-fail-lint
lint-ci-config:
- image: nixos/nix:2.25.2
- extends: .lint
+ extends: [.lint, .nix]
# We don't need history/submodules in this job
variables:
GIT_DEPTH: 1
GIT_SUBMODULE_STRATEGY: none
- before_script:
- - echo "experimental-features = nix-command flakes" >> /etc/nix/nix.conf
- # Note [Nix-in-Docker]
- # ~~~~~~~~~~~~~~~~~~~~
- # The nixos/nix default config is max-jobs=1 and cores=$(logical
- # cores num) which doesn't play nice with our $CPUS convention. We
- # fix it before invoking any nix build to avoid oversubscribing
- # while allowing a reasonable degree of parallelism.
- # FIXME: Disabling build-users-group=nixbld is a workaround for a Nix-in-Docker issue. See
- # https://gitlab.haskell.org/ghc/head.hackage/-/issues/38#note_560487 for
- # discussion.
- - echo "cores = $CPUS" >> /etc/nix/nix.conf
- - echo "max-jobs = $CPUS" >> /etc/nix/nix.conf
- - nix run nixpkgs#gnused -- -i -e 's/ nixbld//' /etc/nix/nix.conf
script:
- nix run .gitlab/generate-ci#generate-jobs
# 1 if .gitlab/generate_jobs changed the output of the generated config
=====================================
utils/check-submodules/LICENSE
=====================================
@@ -0,0 +1,30 @@
+Copyright (c) 2024, Ben Gamari
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+ * Redistributions of source code must retain the above copyright
+ notice, this list of conditions and the following disclaimer.
+
+ * Redistributions in binary form must reproduce the above
+ copyright notice, this list of conditions and the following
+ disclaimer in the documentation and/or other materials provided
+ with the distribution.
+
+ * Neither the name of Ben Gamari nor the names of other
+ contributors may be used to endorse or promote products derived
+ from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
=====================================
utils/check-submodules/README.mkd
=====================================
@@ -0,0 +1,16 @@
+# check-submodules
+
+This is a utilities used in GHC CI to verify the consistency and
+up-to-date-ness of GHC's boot library dependencies. Specifically
+we verify that:
+
+ * the referenced commits are released on Hackage
+ * that the Hackage version has not been deprecated
+ * that there is not a more recent version in the same major series
+
+## Usage
+
+In the GHC tree:
+```bash
+nix run ./utils/check-submodules#
+```
=====================================
utils/check-submodules/app/Main.hs
=====================================
@@ -0,0 +1,15 @@
+module Main (main) where
+
+import CheckVersions
+import CheckTags
+import System.Environment (getArgs)
+
+main :: IO ()
+main = do
+ args <- getArgs
+ case args of
+ ["check-versions"] -> checkVersions
+ ["check-tags"] -> checkTags
+ ["summarize"] -> summarize
+ ["email"] -> maintainerEmails >>= putStrLn
+ _ -> fail "invalid mode"
=====================================
utils/check-submodules/check-submodules.cabal
=====================================
@@ -0,0 +1,47 @@
+cabal-version: 3.0
+name: check-submodules
+version: 0.1.0.0
+-- synopsis:
+-- description:
+homepage: https://gitlab.haskell.org/ghc/ghc
+license: BSD-3-Clause
+license-file: LICENSE
+author: Ben Gamari
+maintainer: ben at smart-cactus.org
+copyright: (c) 2024 Ben Gamari
+category: Development
+build-type: Simple
+-- extra-source-files:
+
+common warnings
+ ghc-options: -Wall
+
+executable check-submodules
+ import: warnings
+ main-is: Main.hs
+ build-depends: base,
+ check-submodules
+ hs-source-dirs: app
+ default-language: Haskell2010
+
+library
+ import: warnings
+ exposed-modules: Git,
+ Hackage,
+ CheckVersions,
+ CheckTags,
+ Packages,
+ Package
+ build-depends: base,
+ wreq,
+ aeson,
+ bytestring,
+ text,
+ transformers,
+ filepath,
+ microlens,
+ containers,
+ typed-process,
+ Cabal
+ hs-source-dirs: src
+ default-language: Haskell2010
=====================================
utils/check-submodules/flake.lock
=====================================
@@ -0,0 +1,58 @@
+{
+ "nodes": {
+ "flake-utils": {
+ "inputs": {
+ "systems": "systems"
+ },
+ "locked": {
+ "lastModified": 1731533236,
+ "narHash": "sha256-l0KFg5HjrsfsO/JpG+r7fRrqm12kzFHyUHqHCVpMMbI=",
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "rev": "11707dc2f618dd54ca8739b309ec4fc024de578b",
+ "type": "github"
+ },
+ "original": {
+ "owner": "numtide",
+ "repo": "flake-utils",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1734083684,
+ "narHash": "sha256-5fNndbndxSx5d+C/D0p/VF32xDiJCJzyOqorOYW4JEo=",
+ "path": "/nix/store/0xbni69flk8380w0apw4h640n37wn1i9-source",
+ "rev": "314e12ba369ccdb9b352a4db26ff419f7c49fa84",
+ "type": "path"
+ },
+ "original": {
+ "id": "nixpkgs",
+ "type": "indirect"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-utils": "flake-utils",
+ "nixpkgs": "nixpkgs"
+ }
+ },
+ "systems": {
+ "locked": {
+ "lastModified": 1681028828,
+ "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
+ "owner": "nix-systems",
+ "repo": "default",
+ "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nix-systems",
+ "repo": "default",
+ "type": "github"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
=====================================
utils/check-submodules/flake.nix
=====================================
@@ -0,0 +1,26 @@
+{
+ description = "GHC boot library linting";
+
+ inputs.flake-utils.url = "github:numtide/flake-utils";
+
+ outputs = { self, nixpkgs, flake-utils }:
+ flake-utils.lib.eachDefaultSystem (system:
+ let pkgs = nixpkgs.legacyPackages.${system}; in
+ {
+ packages = rec {
+ check-submodules = pkgs.haskellPackages.callCabal2nix "generate-ci" ./. {};
+ default = check-submodules;
+ };
+
+ devShells.default = self.packages.${system}.default.env;
+
+ apps = rec {
+ check-submodules = flake-utils.lib.mkApp {
+ drv = self.packages.${system}.check-submodules;
+ };
+ default = check-submodules;
+ };
+ }
+ );
+}
+
=====================================
utils/check-submodules/hie.yaml
=====================================
@@ -0,0 +1,2 @@
+cradle:
+ cabal:
=====================================
utils/check-submodules/src/CheckTags.hs
=====================================
@@ -0,0 +1,56 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module CheckTags
+ ( checkTags
+ ) where
+
+import Package (Package(..))
+import Packages (packages)
+import Git qualified
+import Data.List (intercalate, isPrefixOf, isSuffixOf)
+import Data.Maybe (catMaybes)
+
+findReleaseTag :: Git.GitRepo -> Package -> IO (Maybe String)
+findReleaseTag repo pkg = do
+ allTags <- Git.reachableTags repo "HEAD"
+ case filter (\tag -> pkgIsReleaseTag pkg tag || isGhcTag tag) allTags of
+ [] -> return Nothing
+ tag:_ -> return (Just tag)
+
+isGhcTag :: String -> Bool
+isGhcTag tag = "-ghc" `isSuffixOf` tag
+
+checkTag :: Git.GitRepo -> Package -> IO (Maybe String)
+checkTag repo pkg = do
+ mb_tag <- findReleaseTag repo pkg
+ case mb_tag of
+ Nothing -> return $ Just "No release tags found"
+ Just tag -> checkChanges repo tag
+
+-- | Check whether the tag only deviates from HEAD in trivial ways.
+checkChanges :: Git.GitRepo -> Git.Ref -> IO (Maybe String)
+checkChanges repo tag = do
+ files <- Git.changedFiles repo tag "HEAD"
+ case filter (not . okayChange) files of
+ [] -> return Nothing
+ badFiles -> do
+ described <- Git.describeRef repo "HEAD"
+ let msg = "Tag " <> show tag <> " differs from " <> described <> " in: " <> fileList
+ maxFiles = 5
+ commaList = intercalate ", "
+ fileList
+ | length badFiles > maxFiles = commaList (take maxFiles badFiles) <> " and " <> show (length badFiles - maxFiles) <> " other files"
+ | otherwise = commaList badFiles
+ return $ Just msg
+
+okayChange :: FilePath -> Bool
+okayChange path
+ | "." `isPrefixOf` path = True
+ | ".gitignore" `isSuffixOf` path = True
+ | otherwise = False
+
+checkTags :: IO ()
+checkTags = do
+ let ghcRepo = Git.GitRepo "."
+ mapM (\pkg -> checkTag (Git.submoduleIn ghcRepo (pkgPath pkg)) pkg) packages >>= putStrLn . unlines . catMaybes
+
=====================================
utils/check-submodules/src/CheckVersions.hs
=====================================
@@ -0,0 +1,79 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+
+module CheckVersions
+ ( checkVersions
+ , summarize
+ , maintainerEmails
+ ) where
+
+import Control.Monad (forM_)
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Writer
+import Data.Function (on)
+import Data.List (intercalate, sort, nubBy)
+import Data.Map.Strict qualified as M
+import Data.Text qualified as T
+import Data.Version
+import Distribution.Types.PackageName qualified as C
+import System.Exit
+
+import Hackage (getVersions, PackageState (..))
+import Package
+import Packages
+
+isPvpCompatible :: Version -> Version -> Bool
+isPvpCompatible a b =
+ take 2 (versionBranch a) == take 2 (versionBranch b)
+
+updateVersion :: M.Map Version PackageState -> Version -> Maybe Version
+updateVersion available v
+ | [] <- compatible = Nothing
+ | otherwise = Just $ maximum compatible
+ where
+ compatible =
+ [ v'
+ | (v', Normal) <- M.assocs available -- non-deprecated versions available via Hackage...
+ , v' > v -- that are newer than the submodule...
+ , v' `isPvpCompatible` v -- and are compatible with the submodule
+ ]
+
+checkPackage :: Package -> WriterT [String] IO ()
+checkPackage pkg = do
+ v <- liftIO $ getPackageVersion pkg
+ available <- liftIO $ getVersions (pkgName pkg)
+
+ case M.lookup v available of
+ Nothing -> tell ["Version not on Hackage"]
+ Just Deprecated -> tell ["Version has been deprecated"]
+ Just Normal -> return ()
+
+ case updateVersion available v of
+ Nothing -> return ()
+ Just v' -> tell ["At " <> showVersion v <> " but version " <> showVersion v' <> " is available"]
+
+formatError :: Package -> String -> String
+formatError pkg err =
+ pkgPath pkg <> ": " <> err
+
+summarizeSubmodules :: [Package] -> IO ()
+summarizeSubmodules pkgs = forM_ pkgs $ \pkg -> do
+ v <- getPackageVersion pkg
+ putStrLn $ " " <> C.unPackageName (pkgName pkg) <> " " <> showVersion v <> " @ " <> pkgPath pkg
+
+maintainerEmails :: IO String
+maintainerEmails = do
+ maintainers <- concat <$> mapM getPackageMaintainers packages
+ return $ intercalate ", " $ map (T.unpack . contactRecipient) $ nubBy ((==) `on` contactEmail) $ sort maintainers
+
+summarize :: IO ()
+summarize =
+ summarizeSubmodules packages
+
+checkVersions :: IO ()
+checkVersions = do
+ errs <- mapM (\pkg -> map (pkg, ) <$> execWriterT (checkPackage pkg)) packages
+ mapM_ (putStrLn . uncurry formatError) (concat errs)
+ exitWith $ if null errs then ExitSuccess else ExitFailure 1
+
=====================================
utils/check-submodules/src/Git.hs
=====================================
@@ -0,0 +1,50 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+
+module Git
+ ( GitRepo(..)
+ , submoduleIn
+
+ , Ref
+ , describeRef
+ , submoduleCommit
+ , reachableTags
+ , changedFiles
+ ) where
+
+import System.Process.Typed
+import Data.ByteString.Lazy.Char8 qualified as BSL
+import System.FilePath ((</>))
+
+newtype GitRepo = GitRepo { gitRepoPath :: FilePath }
+
+submoduleIn :: GitRepo -> FilePath -> GitRepo
+submoduleIn (GitRepo path) submod =
+ GitRepo $ path </> submod
+
+type Ref = String
+
+runGit :: GitRepo -> [String] -> IO BSL.ByteString
+runGit (GitRepo path) args = do
+ readProcessStdout_ $ setWorkingDir path (proc "git" args)
+
+describeRef :: GitRepo -> Ref -> IO String
+describeRef repo ref =
+ head . lines . BSL.unpack <$> runGit repo ["describe", "--always", ref]
+
+-- | Get the commit of the given submodule.
+submoduleCommit :: GitRepo -> FilePath -> IO Ref
+submoduleCommit repo submodule = do
+ out <- runGit repo ["submodule", "status", submodule]
+ case BSL.words $ BSL.drop 1 out of
+ commit:_ -> return $ BSL.unpack commit
+ _ -> fail "Unrecognized output from `git submodule status`"
+
+-- | Get the most recent tags reacheable from the given commit.
+reachableTags :: GitRepo -> Ref -> IO [Ref]
+reachableTags repo ref =
+ reverse . map BSL.unpack . BSL.lines <$> runGit repo ["tag", "--sort=taggerdate", "--merged", ref]
+
+changedFiles :: GitRepo -> Ref -> Ref -> IO [FilePath]
+changedFiles repo a b = do
+ map BSL.unpack . BSL.lines <$> runGit repo ["diff", "--name-only", a, b]
+
=====================================
utils/check-submodules/src/Hackage.hs
=====================================
@@ -0,0 +1,32 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Hackage
+ ( PackageState(..)
+ , getVersions
+ ) where
+
+import qualified Data.Map.Strict as M
+import Lens.Micro
+import Network.Wreq
+import Distribution.Types.PackageName
+import qualified Data.Aeson as JSON
+import Data.Version
+
+data PackageState = Normal | Deprecated
+ deriving (Show)
+
+instance JSON.FromJSON PackageState where
+ parseJSON = JSON.withText "package state" $ \case
+ "normal" -> pure Normal
+ "deprecated" -> pure Deprecated
+ _ -> fail "unknown PackageState"
+
+getVersions :: PackageName -> IO (M.Map Version PackageState)
+getVersions pn = do
+ r <- asJSON =<< getWith opts url
+ maybe (fail "getVersions: failed") pure (r ^? responseBody)
+ where
+ opts = defaults & header "Accept" .~ ["application/json"]
+ url = "https://hackage.haskell.org/package/" <> unPackageName pn
+
=====================================
utils/check-submodules/src/Package.hs
=====================================
@@ -0,0 +1,62 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Package
+ ( Contact(..)
+ , parseContact
+ , contactRecipient
+
+ , Package(..)
+ , getPackageVersion
+ , getPackageMaintainers
+ ) where
+
+import Data.ByteString qualified as BS
+import Data.Text qualified as T
+import Data.Version
+import Distribution.PackageDescription.Parsec qualified as C
+import Distribution.Types.GenericPackageDescription qualified as C
+import Distribution.Types.PackageDescription qualified as C
+import Distribution.Types.PackageId qualified as C
+import Distribution.Types.PackageName (PackageName)
+import Distribution.Types.PackageName qualified as C
+import Distribution.Types.Version qualified as C
+import Distribution.Utils.ShortText qualified as C
+import System.FilePath
+
+data Contact = Contact { contactName, contactEmail :: T.Text }
+ deriving (Eq, Ord, Show)
+
+parseContact :: T.Text -> Contact
+parseContact t
+ | '<' `T.elem` t =
+ let (name,email) = T.break (== '<') t
+ in Contact (T.strip name) (T.strip $ T.takeWhile (/= '>') $ T.drop 1 email)
+ | otherwise = Contact "" t
+
+contactRecipient :: Contact -> T.Text
+contactRecipient (Contact name email)
+ | T.null name = email
+ | otherwise = name <> " <" <> email <> ">"
+
+data Package = Package { pkgName :: PackageName
+ , pkgPath :: FilePath
+ , pkgIsReleaseTag :: String -> Bool
+ }
+
+getPackageDescription :: Package -> IO C.PackageDescription
+getPackageDescription pkg = do
+ Just gpd <- C.parseGenericPackageDescriptionMaybe <$> BS.readFile (pkgPath pkg </> C.unPackageName (pkgName pkg) <.> "cabal")
+ return $ C.packageDescription gpd
+
+getPackageMaintainers :: Package -> IO [Contact]
+getPackageMaintainers pkg =
+ map (parseContact . T.strip . T.filter (/= '\n')) . T.splitOn ","
+ . T.pack . C.fromShortText . C.maintainer
+ <$> getPackageDescription pkg
+
+getPackageVersion :: Package -> IO Version
+getPackageVersion pkg =
+ Data.Version.makeVersion . C.versionNumbers . C.pkgVersion . C.package
+ <$> getPackageDescription pkg
+
=====================================
utils/check-submodules/src/Packages.hs
=====================================
@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Packages (packages) where
+
+import Package
+import Data.Char (isDigit)
+import qualified Distribution.Types.PackageName as C
+import Data.List
+
+packages :: [Package]
+packages =
+ [ stdPackage "file-io" "libraries/file-io"
+ , stdPackage "hsc2hs" "utils/hsc2hs"
+ , Package "Cabal" "libraries/Cabal/Cabal" (isPrefixTag "Cabal-")
+ , Package "Cabal-syntax" "libraries/Cabal/Cabal-syntax" (isPrefixTag "Cabal-syntax-")
+ , stdPackage "bytestring" "libraries/bytestring"
+ , stdPackage "binary" "libraries/binary"
+ , stdPackage "array" "libraries/array"
+ , stdPackage "containers" "libraries/containers/containers"
+ , stdPackage "deepseq" "libraries/deepseq"
+ , stdPackage "directory" "libraries/directory"
+ , stdPackage "filepath" "libraries/filepath"
+ , stdPackage "haskeline" "libraries/haskeline"
+ , stdPackage "hpc" "libraries/hpc"
+ , stdPackage "mtl" "libraries/mtl"
+ , stdPackage "parsec" "libraries/parsec"
+ , stdPackage "pretty" "libraries/pretty"
+ , stdPackage "process" "libraries/process"
+ , stdPackage "terminfo" "libraries/terminfo"
+ , stdPackage "text" "libraries/text"
+ , stdPackage "time" "libraries/time"
+ , stdPackage "unix" "libraries/unix"
+ , stdPackage "exceptions" "libraries/exceptions"
+ , stdPackage "semaphore-compat" "libraries/semaphore-compat"
+ , stdPackage "stm" "libraries/stm"
+ , stdPackage "Win32" "libraries/Win32"
+ , stdPackage "xhtml" "libraries/xhtml"
+ ]
+
+stdPackage :: C.PackageName -> FilePath -> Package
+stdPackage name path = Package name path stdIsReleaseTag
+
+looksLikeVersion :: String -> Bool
+looksLikeVersion =
+ all (\c -> isDigit c || c == '.')
+
+isPrefixTag :: String -> String -> Bool
+isPrefixTag prefix tag
+ | Just rest <- prefix `stripPrefix` tag = looksLikeVersion rest
+ | otherwise = False
+
+stdIsReleaseTag :: String -> Bool
+stdIsReleaseTag tag =
+ isPrefixTag "v" tag || isPrefixTag "" tag
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f703ff55fe7426340ca3c933ddd949bd6edc1cc...eae74661c8d8a7381bcd86948a86cbde4be4d1fc
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4f703ff55fe7426340ca3c933ddd949bd6edc1cc...eae74661c8d8a7381bcd86948a86cbde4be4d1fc
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241220/740b72a9/attachment-0001.html>
More information about the ghc-commits
mailing list