From 6555b68ca0678827b89c5624db071f5a485d18b7 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 18 Feb 2022 17:27:32 +0100 Subject: Move linters into the tree This MR moves the GHC linters into the tree, so that they can be run directly using Hadrian. * Query all files tracked by Git instead of using changed files, so that we can run the exact same linting step locally and in a merge request. * Only check that the changelogs don't contain TBA when RELEASE=YES. * Add hadrian/lint script, which runs all the linting steps. * Ensure the hlint job exits with a failure if hlint is not installed (otherwise we were ignoring the failure). Given that hlint doesn't seem to be available in CI at the moment, I've temporarily allowed failure in the hlint job. * Run all linting tests in CI using hadrian. --- utils/notes-util/Main.hs | 62 ------------- utils/notes-util/Makefile | 17 ---- utils/notes-util/Notes.hs | 186 -------------------------------------- utils/notes-util/check.sh | 30 ------ utils/notes-util/ghc.mk | 18 ---- utils/notes-util/notes-util.cabal | 21 ----- utils/notes-util/test | 25 ----- 7 files changed, 359 deletions(-) delete mode 100644 utils/notes-util/Main.hs delete mode 100644 utils/notes-util/Makefile delete mode 100644 utils/notes-util/Notes.hs delete mode 100755 utils/notes-util/check.sh delete mode 100644 utils/notes-util/ghc.mk delete mode 100644 utils/notes-util/notes-util.cabal delete mode 100644 utils/notes-util/test (limited to 'utils') diff --git a/utils/notes-util/Main.hs b/utils/notes-util/Main.hs deleted file mode 100644 index aa9386bc01..0000000000 --- a/utils/notes-util/Main.hs +++ /dev/null @@ -1,62 +0,0 @@ -import qualified Data.Set as S -import System.Process -import System.Environment - -import Notes - -usage :: IO a -usage = do - putStrLn $ unlines - [ "usage:" - , " ghc-notes " - , " ghc-notes @" - , " ghc-notes " - , "" - , "valid modes:" - , " dump dump all Note definitions and references" - , " defs dump all Note definitions" - , " refs dump all Note references" - , " unreferenced dump all unreferenced Note definitions" - , " broken-refs dump all references to missing Notes" - ] - fail "invalid usage" - -main :: IO () -main = do - args <- getArgs - - let printNoteDefs = putStrLn . unlines . map showNoteDef - printNoteRefs = putStrLn . unlines . map showNoteRef - printNoteRefsSugg (bad, sugg) = do - putStrLn . showNoteRef $ bad - putStrLn $ " >" ++ showNoteDef sugg - - - parseMode :: String -> Maybe (NoteDb -> IO ()) - parseMode "dump" = Just $ putStrLn . showNoteDb - parseMode "unreferenced" = Just $ printNoteDefs . S.toList . unreferencedNotes - parseMode "defs" = Just $ printNoteDefs . allNoteDefs - parseMode "refs" = Just $ printNoteRefs . allNoteRefs - parseMode "broken-refs" = Just $ printNoteRefs . map fst . brokenNoteRefs - parseMode "broken-refs-suggest" = Just $ mapM_ printNoteRefsSugg . brokenNoteRefs - parseMode _ = Nothing - - (mode, files) <- case args of - [mode, "@-"] -> do - files <- lines <$> getContents - return (parseMode mode, files) - [mode, '@':respFile] -> do - files <- lines <$> readFile respFile - return (parseMode mode, files) - [mode] -> do - let excludeList = - [ "testsuite/tests/linters/notes.stdout" - , "utils/notes-util/test" ] - files <- lines <$> readProcess "git" ["ls-tree", "--name-only", "-r", "HEAD"] "" - return (parseMode mode, filter (`notElem` excludeList) files) - _ -> usage - - case mode of - Just run -> filesNotes files >>= run - Nothing -> return () - diff --git a/utils/notes-util/Makefile b/utils/notes-util/Makefile deleted file mode 100644 index 176527a3c7..0000000000 --- a/utils/notes-util/Makefile +++ /dev/null @@ -1,17 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -dir = utils/notes-util -TOP = ../.. -include $(TOP)/mk/sub-makefile.mk - -FAST_MAKE_OPTS += stage=none diff --git a/utils/notes-util/Notes.hs b/utils/notes-util/Notes.hs deleted file mode 100644 index cf267d8d67..0000000000 --- a/utils/notes-util/Notes.hs +++ /dev/null @@ -1,186 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE BangPatterns #-} - -module Notes where - -import Data.Either -import Data.Foldable -import qualified Data.ByteString as BS -import qualified Data.Text as T -import qualified Data.Text.Encoding as T -import qualified Data.Map.Strict as M -import qualified Data.Set as S -import System.Directory (doesFileExist) -import Data.Array -import Data.List (sortBy) -import Data.Ord - -data SrcLoc = SrcLoc { fileName :: FilePath - , row :: !Int - , column :: !Int - } - deriving (Eq, Ord, Show) - -showSrcLoc :: SrcLoc -> String -showSrcLoc loc = - concat [fileName loc, ":", show (row loc), ":", show (column loc), ":"] - -newtype NoteName = NoteName T.Text - deriving (Eq, Ord, Show) - -showNoteName :: NoteName -> String -showNoteName (NoteName x) = "Note [" <> T.unpack x <> "]" - -data NoteDef = NoteDef { noteDefSrcLoc :: !SrcLoc - , noteDefName :: !NoteName - } - deriving (Eq, Ord, Show) - -showNoteDef :: NoteDef -> String -showNoteDef (NoteDef{noteDefSrcLoc=loc, noteDefName=name}) = - "def " <> showSrcLoc loc <> " " <> showNoteName name - -data NoteRef = NoteRef { noteRefSrcLoc :: !SrcLoc - , noteRefName :: !NoteName - } - deriving (Eq, Ord, Show) - -showNoteRef :: NoteRef -> String -showNoteRef (NoteRef{noteRefSrcLoc=loc, noteRefName=name}) = - "ref " <> showSrcLoc loc <> " " <> showNoteName name - -findNotes :: FilePath -> T.Text -> [Either NoteRef NoteDef] -findNotes fname t = - go 1 (T.lines t) - where - go :: Int -> [T.Text] -> [Either NoteRef NoteDef] - -- Note definitions: - -- We look for a "Note [" token with a "~~~" rule beneath it. - go !lineNo (l0 : l1 : ls) - | hasRule = Right (NoteDef srcLoc name) : go (lineNo+2) ls - where - (prefix, rest) = T.breakOn "Note [" l0 - startCol = T.length prefix - hasRule = T.take 3 (T.drop startCol l1) == "~~~" - srcLoc = SrcLoc fname lineNo startCol - name = NoteName $ T.takeWhile (/= ']') $ T.drop 6 rest - - -- Note references: - -- We look for a "Note [...]", strip away any beginning-of-line - -- comment symbols, and merge whitespace. - go lineNo (l0 : ls) = - [ Left (NoteRef srcLoc (NoteName name)) - | (prefix, rest) <- T.breakOnAll "Note [" l0 - , let startCol = T.length prefix - srcLoc = SrcLoc fname lineNo startCol - (name, suffix) = T.breakOn "]" (T.drop 6 rest<>" "<>T.concat (map stripBeginningOfLineComment $ take 1 ls)) - , "]" `T.isPrefixOf` suffix - ] ++ go (lineNo+1) ls - - go _lineNo [] = [] - -stripBeginningOfLineComment :: T.Text -> T.Text -stripBeginningOfLineComment = T.pack . go . T.unpack - where - -- This implements the following regular expression substitution: - -- - -- s/$ *[(\-\- )\#( \* )] */ / - - go :: String -> String - go ('#':rest) = finish rest - go ('-':'-':rest) = finish rest - go (' ':'*':rest) = finish rest - go ('/':'/':rest) = finish rest - go (' ':rest) = go rest - go xs = finish xs - - finish :: String -> String - finish = dropWhile (==' ') - -data NoteDb = NoteDb { noteRefs :: M.Map FilePath (S.Set NoteRef) - , noteDefs :: M.Map NoteName (S.Set NoteDef) - } - -instance Monoid NoteDb where - mempty = NoteDb M.empty M.empty - -instance Semigroup NoteDb where - NoteDb a b <> NoteDb c d = - NoteDb (M.unionWith (<>) a c) (M.unionWith (<>) b d) - -allNoteDefs :: NoteDb -> [NoteDef] -allNoteDefs db = - [ def - | defs <- M.elems (noteDefs db) - , def <- S.toList defs - ] - -allNoteRefs :: NoteDb -> [NoteRef] -allNoteRefs db = - [ ref - | (_fname, refs) <- M.toList (noteRefs db) - , ref <- S.toList refs - ] - -showNoteDb :: NoteDb -> String -showNoteDb db = unlines $ - map showNoteRef (allNoteRefs db) - ++ - map showNoteDef (allNoteDefs db) - -filesNotes :: [FilePath] - -> IO NoteDb -filesNotes = fmap mconcat . mapM fileNotes - -fileNotes :: FilePath -> IO NoteDb -fileNotes fname = do - is_file <- doesFileExist fname - if is_file - then do - bs <- BS.readFile fname - return $ case T.decodeUtf8' bs of - Left _ -> mempty - Right t -> - let (refs, defs) = partitionEithers (findNotes fname t) - in NoteDb - { noteRefs = M.singleton fname (S.fromList refs) - , noteDefs = M.fromList - [ (noteDefName def, S.singleton def) - | def <- defs - ] - } - else return mempty - -brokenNoteRefs :: NoteDb -> [(NoteRef, NoteDef)] -brokenNoteRefs db = - [ (ref, best_match) - | (_fname, refs) <- M.toList (noteRefs db) - , ref <- S.toList refs - , Nothing <- pure $ M.lookup (noteRefName ref) (noteDefs db) - , let best_match = bestLev (show (noteRefName ref)) (concatMap S.toList (M.elems (noteDefs db))) - ] - -bestLev :: String -> [NoteDef] -> NoteDef -bestLev x ds = head $ sortBy (comparing (\d -> lev x (show (noteDefName d)))) ds - - -lev:: (Eq a) => [a] -> [a] -> Int -lev xs ys = levMemo ! (n, m) - where levMemo = array ((0,0),(n,m)) [((i,j),lev' i j) | i <- [0..n], j <- [0..m]] - n = length xs - m = length ys - xa = listArray (1, n) xs - ya = listArray (1, m) ys - lev' 0 v = v - lev' u 0 = u - lev' u v - | xa ! u == ya ! v = levMemo ! (u-1, v-1) - | otherwise = 1 + minimum [levMemo ! (u, v-1), - levMemo ! (u-1, v), - levMemo ! (u-1, v-1)] - -unreferencedNotes :: NoteDb -> S.Set NoteDef -unreferencedNotes db = - fold $ noteDefs db `M.withoutKeys` referencedNotes - where - referencedNotes = S.fromList $ map noteRefName (allNoteRefs db) diff --git a/utils/notes-util/check.sh b/utils/notes-util/check.sh deleted file mode 100755 index acac923471..0000000000 --- a/utils/notes-util/check.sh +++ /dev/null @@ -1,30 +0,0 @@ -#!/bin/sh - -set -e - -CABAL_INSTALL="${CABAL_INSTALL:-cabal}" -GHC="${GHC:-ghc}" - -cd "$(dirname $0)" -"$CABAL_INSTALL" build -w "$GHC" -bin="$("$CABAL_INSTALL" list-bin -w "$GHC" ghc-notes)" -cd "$(git rev-parse --show-toplevel)" -"$bin" broken-refs \ - | grep -v "utils/notes-util/expected-broken-note-refs:" \ - | sed 's/:[0-9]\+:[0-9]\+:/:/' \ - > broken-note-refs - -if diff -q utils/notes-util/expected-broken-note-refs broken-note-refs; then - printf "No unexpected broken note references" -else - printf "Found unexpected broken note references:\n\n" - diff -u utils/notes-util/expected-broken-note-refs broken-note-refs || true - if [[ "$1" == "-a" ]]; then - cp broken-note-refs utils/notes-util/expected-broken-note-refs - printf "\n" - printf "Accepted new broken note references." - else - exit 1 - fi -fi - diff --git a/utils/notes-util/ghc.mk b/utils/notes-util/ghc.mk deleted file mode 100644 index 99f8628b70..0000000000 --- a/utils/notes-util/ghc.mk +++ /dev/null @@ -1,18 +0,0 @@ -# ----------------------------------------------------------------------------- -# -# (c) 2009 The University of Glasgow -# -# This file is part of the GHC build system. -# -# To understand how the build system works and how to modify it, see -# https://gitlab.haskell.org/ghc/ghc/wikis/building/architecture -# https://gitlab.haskell.org/ghc/ghc/wikis/building/modifying -# -# ----------------------------------------------------------------------------- - -utils/notes-util_USES_CABAL = YES -utils/notes-util_PACKAGE = notes-util -utils/notes-util_dist-install_PROGNAME = notes-util -utils/notes-util_dist-install_INSTALL = NO -utils/notes-util_dist-install_INSTALL_INPLACE = YES -$(eval $(call build-prog,utils/notes-util,dist-install,1)) diff --git a/utils/notes-util/notes-util.cabal b/utils/notes-util/notes-util.cabal deleted file mode 100644 index 41b1a5afdd..0000000000 --- a/utils/notes-util/notes-util.cabal +++ /dev/null @@ -1,21 +0,0 @@ -cabal-version: 2.4 -name: notes-util -version: 0.1.0.0 -synopsis: A tool for querying and checking GHC Notes -bug-reports: https://gitlab.haskell.org/ghc/ghc -license: BSD-3-Clause -author: Ben Gamari -maintainer: ben@smart-cactus.org -copyright: (c) 2022 Ben Gamari - -executable notes-util - main-is: Main.hs - other-modules: Notes - build-depends: base >= 4 && < 5 , - bytestring, - containers, - directory, - text, - process, - array - default-language: Haskell2010 diff --git a/utils/notes-util/test b/utils/notes-util/test deleted file mode 100644 index 3eb1e0466e..0000000000 --- a/utils/notes-util/test +++ /dev/null @@ -1,25 +0,0 @@ -Note [Turtles] -~~~~~~~~~~~~~~~ -This is note 1. See Note [Wombats are toes]. - -/* Note [Wombats are toes] - ~~~~~~~~~~~~~~~~~~~~~~~ - This is another Note. - */ - -See Note [This is a -Note reference broken across lines]. - - // This is another Note [Broken - // across a line in a C++ comment]. - - /* - * This is another Note [Broken - * across a line in a C comment]. - */ - - -- This is another Note [Broken - -- across a line in a Haskell comment]. - - # This is another Note [Broken - # across a line in a Python comment]. -- cgit v1.2.1