"
- ,escapeHTML (showSrcLoc (getPointLoc ideaSpan) ++ ": " ++ show ideaSeverity ++ ": " ++ ideaHint) ++ "
"
+ ,escapeHTML (GHC.showSrcSpan ideaSpan ++ ": " ++ show ideaSeverity ++ ": " ++ ideaHint) ++ "
"
,"Found
"
,hsColourHTML ideaFrom] ++
(case ideaTo of
diff --git a/src/SARIF.hs b/src/SARIF.hs
new file mode 100644
--- /dev/null
+++ b/src/SARIF.hs
@@ -0,0 +1,178 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+{- |
+Description: Formats hlint ideas in the Statis Analysis Results Interchange Format (SARIF).
+License: BSD-3-Clause
+
+Supports the conversion of a list of HLint 'Idea's into SARIF.
+
+SARIF (Static Analysis Results Interchange Format) is an open interchange format
+for storing results from static analyses.
+-}
+module SARIF ( printIdeas
+ , showIdeas
+ , toJSONEncoding
+ -- * See also
+ --
+ -- $references
+ ) where
+
+import Data.Aeson hiding (Error)
+import Data.Aeson.Encoding
+import Data.ByteString.Lazy (ByteString)
+import Data.ByteString.Lazy qualified as B
+import Data.Text.Lazy (Text)
+import Data.Version (showVersion)
+import GHC.Util
+import Idea
+import Paths_hlint (version)
+
+-- | Print the given ideas to standard output.
+--
+-- For example:
+--
+-- >>> hlint ["src"] >>= printIdeas
+--
+-- For printing ideas in SARIF without dependent modules
+-- having to import "Data.Aeson" or "Data.ByteString.Lazy".
+printIdeas :: [Idea] -> IO ()
+printIdeas = B.putStr . showIdeas
+
+-- | Format the given ideas in SARIF.
+--
+-- For converting ideas to SARIF without dependent modules
+-- having to import "Data.Aeson".
+showIdeas :: [Idea] -> ByteString
+showIdeas = encodingToLazyByteString . toJSONEncoding
+
+-- | Converts the given ideas to a "Data.Aeson" encoding in SARIF.
+toJSONEncoding :: [Idea] -> Encoding
+toJSONEncoding = pairs . sarif
+
+-- | Converts the given object to a top-level @sarifLog@ object.
+--
+-- See section 3.13 "sarifLog object", SARIF specification.
+sarif :: [Idea] -> Series
+sarif ideas =
+ pair "version" (lazyText "2.1.0") <>
+ pair "$schema" (lazyText schemaURI) <>
+ pair "runs" runs
+ where runs = list pairs [ pair "tool" (pairs tool) <>
+ pair "results" (list (pairs . toResult) ideas) ]
+
+-- | A @tool@ object describing what created the output.
+--
+-- Obviously, it will describe that HLint created the output.
+--
+-- See section 3.18 "tool object", SARIF specification.
+tool :: Series
+tool = pair "driver" $ pairs $
+ pair "name" (lazyText "hlint") <>
+ pair "version" (string $ showVersion version) <>
+ pair "informationUri" (lazyText hlintURI)
+
+-- | Converts a given idea into a @result@ object.
+--
+-- It will describe the hint, the severity, suggestions for fixes, etc.
+--
+-- See section 3.27 "result object", SARIF specification.
+toResult :: Idea -> Series
+toResult idea@Idea{..} =
+ pair "message" (pairs $ pair "text" $ string $ show idea) <>
+ pair "level" (lazyText $ showSeverity ideaSeverity) <>
+ pair "locations" (list (pairs . toLocation) [idea]) <>
+ pair "fixes" (list (pairs . toFix) [idea]) <>
+ -- Use 'ideaHint' as the rule identifier.
+ --
+ -- "ruleId" is supposed to a stable, opaque identifier.
+ -- 'ideaHint' is not opaque, nor is it quite guaranteed to be stable,
+ -- but they will usually be stable enough, and disabling a hint is
+ -- based on the name in 'ideaHint'.
+ --
+ -- Most importantly, there is no requirement that "ruleId"
+ -- be a /unique/ identifier.
+ pair "ruleId" (string ideaHint)
+
+-- | Convert HLint severity to SARIF level.
+--
+-- See section 3.58.6 "level property", SARIF specification.
+showSeverity :: Severity -> Text
+showSeverity Error = "error"
+showSeverity Warning = "warning"
+showSeverity Suggestion = "note"
+showSeverity Ignore = "none"
+
+-- | Converts the location information in a given idea to a @location@ object.
+--
+-- See section 3.28 "location object", SARIF specification.
+toLocation :: Idea -> Series
+toLocation idea@Idea{ideaSpan=SrcSpan{..}, ..} =
+ physicalLocation <> logicalLocations ideaModule ideaDecl
+ where physicalLocation = pair "physicalLocation" $ pairs $
+ pair "artifactLocation"
+ (pairs $ pair "uri" (string srcSpanFilename)) <>
+ pair "region" (pairs $ toRegion idea)
+
+ logicalLocations [mod] [decl] = pair "logicalLocations" $
+ list pairs [ pair "name" (string decl) <>
+ pair "fullyQualifiedName" (string $ mod ++ "." ++ decl) ]
+ -- It would be nice to include whether it is a function or type
+ -- in the "kind" field, but we do not have that information.
+
+ -- If the lists are empty, then there is obviously no logical location.
+ -- Logical location is still omitted when the lists are not singleton,
+ -- because the associations between modules and declarations are
+ -- not clear.
+ logicalLocations _ _ = mempty
+
+-- | Converts a given idea to a @fix@ object.
+--
+-- It will suggest how code can be improved to deal with an issue.
+-- This includes the file to be changed and how to change it.
+--
+-- See section 3.55 "fix object", SARIF specification.
+toFix :: Idea -> Series
+toFix idea@Idea{..} =
+ pair "description" (pairs $ pair "text" $ string ideaHint) <>
+ pair "artifactChanges" (list (pairs . toChange) [idea])
+
+-- | Converts a given idea to a @artifactChange@ object.
+--
+-- It will describe the details as to how the code can be changed.
+-- I.e., the text to remove and what it should be replaced with.
+--
+-- See section 3.56 "artifactChange object", SARIF specification.
+toChange :: Idea -> Series
+toChange idea@Idea{ideaSpan=SrcSpan{..}, ..} =
+ pair "artifactLocation" (pairs uri) <>
+ pair "replacements" (list pairs [deleted <> inserted])
+ where uri = pair "uri" $ string srcSpanFilename
+ deleted = pair "deletedRegion" $ pairs $ toRegion idea
+ inserted = maybe mempty insertedContent ideaTo
+ insertedContent = pair "insertedContent" . pairs . pair "text" . string
+
+-- | Converts the source span in an idea to a SARIF region.
+--
+-- See 3.30 "region object", SARIF specification.
+toRegion :: Idea -> Series
+toRegion Idea{ideaSpan=SrcSpan{..}, ..} =
+ pair "startLine" (int srcSpanStartLine') <>
+ pair "startColumn" (int srcSpanStartColumn) <>
+ pair "endLine" (int srcSpanEndLine') <>
+ pair "endColumn" (int srcSpanEndColumn)
+
+-- | URI to SARIF schema definition.
+schemaURI :: Text
+schemaURI = "https://raw.githubusercontent.com/" <>
+ "oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json"
+
+-- | URI to HLint home page.
+hlintURI :: Text
+hlintURI = "https://github.com/ndmitchell/hlint"
+
+-- $references
+--
+-- * [SARIF Tutorials](https://github.com/microsoft/sarif-tutorials)
+-- * [Static Analysis Results Interchange Format](https://docs.oasis-open.org/sarif/sarif/v2.1.0/cs01/sarif-v2.1.0-cs01.html), version 2.1.0
diff --git a/src/Summary.hs b/src/Summary.hs
new file mode 100644
--- /dev/null
+++ b/src/Summary.hs
@@ -0,0 +1,202 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DataKinds #-}
+
+module Summary (generateMdSummary, generateJsonSummary, generateExhaustiveConfig) where
+
+import Data.Map qualified as Map
+import Control.Monad.Extra
+import System.FilePath
+import Data.List.NonEmpty qualified as NE
+import Data.List.Extra
+import System.Directory
+
+import Idea
+import Apply
+import Hint.Type
+import Hint.All
+import Config.Type
+import Test.Annotations
+import Deriving.Aeson
+import Data.Aeson (encode)
+import Data.ByteString.Char8 (unpack)
+import Data.ByteString.Lazy (toStrict)
+
+data Summary = Summary
+ { sBuiltinRules :: ![BuiltinHint]
+ , sLhsRhsRules :: ![HintRule]
+ } deriving (Show, Generic)
+ deriving (ToJSON) via CustomJSON '[FieldLabelModifier (StripPrefix "s", CamelToSnake)] Summary
+
+data BuiltinHint = BuiltinHint
+ { hName :: !String
+ , hSeverity :: !Severity
+ , hRefactoring :: !Bool
+ , hCategory :: !String
+ , hExamples :: ![BuiltinExample]
+ } deriving (Show, Eq, Ord, Generic)
+ deriving (ToJSON) via CustomJSON '[FieldLabelModifier (StripPrefix "h", CamelToSnake)] BuiltinHint
+
+data BuiltinKey = BuiltinKey
+ { kName :: !String
+ , kSeverity :: !Severity
+ , kRefactoring :: !Bool
+ , kCategory :: !String
+ } deriving (Show, Eq, Ord)
+
+data BuiltinExample = BuiltinExample
+ { eContext :: !String
+ , eFrom :: !String
+ , eTo :: !(Maybe String)
+ } deriving (Show, Eq, Ord, Generic)
+ deriving (ToJSON) via CustomJSON '[FieldLabelModifier (StripPrefix "e", CamelToSnake)] BuiltinExample
+
+dedupBuiltin :: [(BuiltinKey, BuiltinExample)] -> [BuiltinHint]
+dedupBuiltin = fmap makeHint . Map.toAscList . Map.fromListWith (<>) . fmap exampleToList where
+ exampleToList (k, e) = (k, [e])
+ makeHint (BuiltinKey{..}, examples) = BuiltinHint
+ kName
+ kSeverity
+ kRefactoring
+ kCategory
+ examples
+
+-- | The summary of built-in hints is generated by running the test cases in
+-- @src/Hint/*.hs@.
+mkBuiltinSummary :: IO [BuiltinHint]
+mkBuiltinSummary = concatForM builtinHints $ \(category, hint) -> do
+ let file = "src/Hint" category <.> "hs"
+ b <- doesFileExist file
+ if not b then do
+ putStrLn $ "Couldn't find source hint file " ++ file ++ ", some hints will be missing"
+ pure []
+ else do
+ tests <- parseTestFile file
+ fmap dedupBuiltin <$> concatForM tests $ \(TestCase _ _ inp _ _) -> do
+ m <- parseModuleEx defaultParseFlags file (Just inp)
+ pure $ case m of
+ Right m -> map (ideaToValue category inp) $ applyHints [] hint [m]
+ Left _ -> []
+ where
+ ideaToValue :: String -> String -> Idea -> (BuiltinKey, BuiltinExample)
+ ideaToValue category inp Idea{..} = (k, v)
+ where
+ -- make sure Windows/Linux don't differ on path separators
+ to = fmap (\x -> if "Combine with " `isPrefixOf` x then replace "\\" "/" x else x) ideaTo
+ k = BuiltinKey ideaHint ideaSeverity (notNull ideaRefactoring) category
+ v = BuiltinExample inp ideaFrom to
+
+getSummary :: [Setting] -> IO Summary
+getSummary settings = do
+ builtinHints <- mkBuiltinSummary
+ let lhsRhsHints = [hint | SettingMatchExp hint <- settings]
+ pure $ Summary builtinHints lhsRhsHints
+
+jsonToString :: ToJSON a => a -> String
+jsonToString = unpack . toStrict . encode
+
+-- | Generate a summary of hints, including built-in hints and YAML-configured hints
+generateMdSummary :: [Setting] -> IO String
+generateMdSummary = fmap genSummaryMd . getSummary
+
+generateJsonSummary :: [Setting] -> IO String
+generateJsonSummary = fmap jsonToString . getSummary
+
+generateExhaustiveConfig :: Severity -> [Setting] -> IO String
+generateExhaustiveConfig severity = fmap (genExhaustiveConfig severity) . getSummary
+
+genExhaustiveConfig :: Severity -> Summary -> String
+genExhaustiveConfig severity Summary{..} = unlines $
+ [ "# HLint configuration file"
+ , "# https://github.com/ndmitchell/hlint"
+ , "##########################"
+ , ""
+ , "# This file contains a template configuration file, which is typically"
+ , "# placed as .hlint.yaml in the root of your project"
+ , ""
+ , "# All built-in hints"
+ ]
+ ++ (mkLine <$> sortDedup (hName <$> sBuiltinRules))
+ ++ ["", "# All LHS/RHS hints"]
+ ++ (mkLine <$> sortDedup (hintRuleName <$> sLhsRhsRules))
+ where
+ sortDedup = fmap (NE.head . NE.fromList) . group . sort
+ mkLine name = "- " <> show severity <> ": {name: " <> jsonToString name <> "}"
+
+genSummaryMd :: Summary -> String
+genSummaryMd Summary{..} = unlines $
+ [ "# Summary of Hints"
+ , ""
+ , "This page is auto-generated from `hlint --generate-summary`."
+ ] ++
+ concat ["" : ("## Builtin " ++ group ) : "" : builtinTable hints | (group, hints) <- groupHintsByCategory sBuiltinRules] ++
+ [ ""
+ , "## Configured hints"
+ , ""
+ ]
+ ++ lhsRhsTable sLhsRhsRules
+ where
+ groupHintsByCategory = Map.toAscList . Map.fromListWith (<>) . fmap keyCategory
+ keyCategory hint = (hCategory hint, [hint])
+
+row :: [String] -> [String]
+row xs = ["
"] ++ xs ++ ["
"]
+
+-- | Render using
if it is single-line, otherwise using .
+haskell :: String -> [String]
+haskell s
+ | '\n' `elem` s = ["", s, "
"]
+ | otherwise = ["", s, "", "
"]
+
+builtinTable :: [BuiltinHint] -> [String]
+builtinTable builtins =
+ ["
"]
+ ++ row ["| Hint Name | ", "Hint | ", "Severity | "]
+ ++ concatMap showBuiltin builtins
+ ++ ["
"]
+
+showBuiltin :: BuiltinHint -> [String]
+showBuiltin BuiltinHint{..} = row1
+ where
+ row1 = row $
+ [ "" ++ hName ++ " | ", ""]
+ ++ showExample (NE.head (NE.fromList hExamples))
+ ++ ["Does not support refactoring." | not hRefactoring]
+ ++ [" | "] ++
+ [ "" ++ show hSeverity ++ " | "
+ ]
+ showExample BuiltinExample{..} =
+ ["Example: "]
+ ++ haskell eContext
+ ++ ["Found:"]
+ ++ haskell eFrom
+ ++ ["Suggestion:"]
+ ++ haskell eTo'
+ where
+ eTo' = case eTo of
+ Nothing -> ""
+ Just "" -> "Perhaps you should remove it."
+ Just s -> s
+
+lhsRhsTable :: [HintRule] -> [String]
+lhsRhsTable hints =
+ [""]
+ ++ row ["| Hint Name | ", "Hint | ", "Severity | "]
+ ++ concatMap showLhsRhs hints
+ ++ ["
"]
+
+showLhsRhs :: HintRule -> [String]
+showLhsRhs HintRule{..} = row $
+ [ "" ++ hintRuleName ++ " | "
+ , ""
+ , "LHS:"
+ ]
+ ++ haskell (show hintRuleLHS)
+ ++ ["RHS:"]
+ ++ haskell (show hintRuleRHS)
+ ++
+ [ " | "
+ , "" ++ show hintRuleSeverity ++ " | "
+ ]
diff --git a/src/Test/All.hs b/src/Test/All.hs
--- a/src/Test/All.hs
+++ b/src/Test/All.hs
@@ -1,14 +1,16 @@
{-# LANGUAGE RecordWildCards #-}
-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
+{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module Test.All(test) where
import Control.Exception
-import System.Console.CmdArgs
import Control.Monad
import Control.Monad.IO.Class
import Data.Char
+import Data.Either.Extra
+import Data.Foldable
import Data.List
+import Data.Maybe
import System.Directory
import System.FilePath
import Data.Functor
@@ -17,59 +19,59 @@
import Config.Type
import Config.Read
import CmdLine
-import HSE.All
+import Refact
import Hint.All
-import Test.Util
-import Test.InputOutput
import Test.Annotations
-import Test.Translate
+import Test.InputOutput
+import Test.Util
import System.IO.Extra
+import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
test :: Cmd -> ([String] -> IO ()) -> FilePath -> [FilePath] -> IO Int
-test CmdTest{..} main dataDir files = do
+test CmdMain{..} main dataDir files = do
+ rpath <- refactorPath (if cmdWithRefactor == "" then Nothing else Just cmdWithRefactor)
+
(failures, ideas) <- withBuffering stdout NoBuffering $ withTests $ do
hasSrc <- liftIO $ doesFileExist "hlint.cabal"
- useSrc <- return $ hasSrc && null files
- testFiles <- if files /= [] then return files else do
+ let useSrc = hasSrc && null files
+ testFiles <- if files /= [] then pure files else do
xs <- liftIO $ getDirectoryContents dataDir
- return [dataDir x | x <- xs, takeExtension x `elem` [".hs",".yml",".yaml"]
- , not $ "HLint_" `isPrefixOf` takeBaseName x]
+ pure [dataDir x | x <- xs, takeExtension x `elem` [".yml",".yaml"]]
testFiles <- liftIO $ forM testFiles $ \file -> do
- hints <- readFilesConfig [(file, Nothing)]
- return (file, hints ++ (if takeBaseName file /= "Test" then [] else map (Builtin . fst) builtinHints))
+ hints <- readFilesConfig [(file, Nothing),("CommandLine.yaml", Just "- group: {name: testing, enabled: true}")]
+ pure (file, hints ++ (if takeBaseName file /= "Test" then [] else map (Builtin . fst) builtinHints))
let wrap msg act = do liftIO $ putStr (msg ++ " "); act; liftIO $ putStrLn ""
- liftIO $ putStrLn "Testing"
+ liftIO $ putStrLn $ "Testing (" ++ (if isRight rpath then "with" else "WITHOUT") ++ " refactoring)"
liftIO $ checkCommentedYaml $ dataDir "default.yaml"
when useSrc $ wrap "Source annotations" $ do
config <- liftIO $ readFilesConfig [(".hlint.yaml",Nothing)]
forM_ builtinHints $ \(name,_) -> do
progress
- testAnnotations (Builtin name : if name == "Restrict" then config else []) $ "src/Hint" name <.> "hs"
+ testAnnotations (Builtin name : if name == "Restrict" then config else [])
+ ("src/Hint" name <.> "hs")
+ (eitherToMaybe rpath)
when useSrc $ wrap "Input/outputs" $ testInputOutput main
wrap "Hint names" $ mapM_ (\x -> do progress; testNames $ snd x) testFiles
- wrap "Hint annotations" $ forM_ testFiles $ \(file,h) -> do progress; testAnnotations h file
- let hs = [h | (file, h) <- testFiles, takeFileName file /= "Test.hs"]
- when cmdTypeCheck $ wrap "Hint typechecking" $
- progress >> testTypeCheck cmdDataDir cmdTempDir hs
- when cmdQuickCheck $ wrap "Hint QuickChecking" $
- progress >> testQuickCheck cmdDataDir cmdTempDir hs
+ wrap "Hint annotations" $ forM_ testFiles $ \(file,h) -> do progress; testAnnotations h file (eitherToMaybe rpath)
when (null files && not hasSrc) $ liftIO $ putStrLn "Warning, couldn't find source code, so non-hint tests skipped"
- getIdeas
- whenLoud $ mapM_ print ideas
- return failures
+ case rpath of
+ Left refactorNotFound -> putStrLn $ unlines [refactorNotFound, "Refactoring tests skipped"]
+ _ -> pure ()
+ pure failures
+
---------------------------------------------------------------------
-- VARIOUS SMALL TESTS
-- Check all hints in the standard config files get sensible names
testNames :: [Setting] -> Test ()
testNames hints = sequence_
- [ failed ["No name for the hint " ++ prettyPrint hintRuleLHS ++ " ==> " ++ prettyPrint hintRuleRHS]
+ [ failed ["No name for the hint " ++ unsafePrettyPrint hintRuleLHS ++ " ==> " ++ unsafePrettyPrint hintRuleRHS]
| SettingMatchExp x@HintRule{..} <- hints, hintRuleName == defaultHintName]
diff --git a/src/Test/Annotations.hs b/src/Test/Annotations.hs
--- a/src/Test/Annotations.hs
+++ b/src/Test/Annotations.hs
@@ -1,51 +1,71 @@
-{-# LANGUAGE PatternGuards, RecordWildCards, ViewPatterns #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE CPP, PatternGuards, RecordWildCards, ViewPatterns #-}
-- | Check the annotations within source and hint files.
-module Test.Annotations(testAnnotations) where
+module Test.Annotations(testAnnotations, parseTestFile, TestCase(..)) where
import Control.Exception.Extra
-import Data.Tuple.Extra
+import Control.Monad
+import Control.Monad.IO.Class
import Data.Char
import Data.Either.Extra
+import Data.Function
+import Data.Functor
import Data.List.Extra
import Data.Maybe
-import Control.Monad
+import Data.Tuple.Extra
+import System.Exit
import System.FilePath
-import Control.Monad.IO.Class
-import Data.Function
-import Data.Yaml
-import qualified Data.ByteString.Char8 as BS
+import System.IO.Extra
+import GHC.All
+import Data.ByteString.Char8 qualified as BS
import Config.Type
import Idea
import Apply
-import HSE.All
+import Extension
+import Refact
import Test.Util
-import Data.Functor
import Prelude
import Config.Yaml
+import GHC.Data.FastString
+import GHC.Util
+import GHC.Types.SrcLoc
+import Language.Haskell.GhclibParserEx.GHC.Utils.Outputable
+#ifdef HS_YAML
+
+import Data.YAML.Aeson (decode1Strict)
+import Data.YAML (Pos)
+import Data.ByteString (ByteString)
+
+decodeEither' :: ByteString -> Either (Pos, String) ConfigYaml
+decodeEither' = decode1Strict
+
+#else
+
+import Data.Yaml
+
+#endif
+
-- Input, Output
-- Output = Nothing, should not match
-- Output = Just xs, should match xs
-data TestCase = TestCase SrcLoc String (Maybe String) [Setting] deriving (Show)
+data TestCase = TestCase SrcLoc Refactor String (Maybe String) [Setting] deriving (Show)
-testAnnotations :: [Setting] -> FilePath -> Test ()
-testAnnotations setting file = do
+data Refactor = TestRefactor | SkipRefactor deriving (Eq, Show)
+
+testAnnotations :: [Setting] -> FilePath -> Maybe FilePath -> Test ()
+testAnnotations setting file rpath = do
tests <- liftIO $ parseTestFile file
mapM_ f tests
where
- f (TestCase loc inp out additionalSettings) = do
+ f (TestCase loc refact inp out additionalSettings) = do
ideas <- liftIO $ try_ $ do
res <- applyHintFile defaultParseFlags (setting ++ additionalSettings) file $ Just inp
evaluate $ length $ show res
- return res
-
- -- the hints from data/Test.hs are really fake hints we don't actually deploy
- -- so don't record them
- when (takeFileName file /= "Test.hs") $
- either (const $ return ()) addIdeas ideas
+ pure res
let good = case (out, ideas) of
(Nothing, Right []) -> True
@@ -54,19 +74,36 @@
let bad =
[failed $
["TEST FAILURE (" ++ show (either (const 1) length ideas) ++ " hints generated)"
- ,"SRC: " ++ showSrcLoc loc
+ ,"SRC: " ++ unsafePrettyPrint loc
,"INPUT: " ++ inp] ++
- map ("OUTPUT: " ++) (either (return . show) (map show) ideas) ++
+ map ("OUTPUT: " ++) (either (pure . show) (map show) ideas) ++
["WANTED: " ++ fromMaybe "" out]
| not good] ++
[failed
["TEST FAILURE (BAD LOCATION)"
- ,"SRC: " ++ showSrcLoc loc
+ ,"SRC: " ++ unsafePrettyPrint loc
,"INPUT: " ++ inp
,"OUTPUT: " ++ show i]
- | i@Idea{..} <- fromRight [] ideas, let SrcLoc{..} = getPointLoc ideaSpan, srcFilename == "" || srcLine == 0 || srcColumn == 0]
- if null bad then passed else sequence_ bad
+ | i@Idea{..} <- fromRight [] ideas, let SrcLoc{..} = srcSpanStart ideaSpan, srcFilename == "" || srcLine == 0 || srcColumn == 0]
+ -- TODO: shouldn't these checks be == -1 instead?
+ -- Skip refactoring test if the hlint test failed, or if the
+ -- test is annotated with @NoRefactor.
+ let skipRefactor = notNull bad || refact == SkipRefactor
+ badRefactor <- if skipRefactor then pure [] else liftIO $ do
+ refactorErr <- case ideas of
+ Right [] -> testRefactor rpath Nothing inp
+ Right [idea] -> testRefactor rpath (Just idea) inp
+ -- Skip refactoring test if there are multiple hints
+ _ -> pure []
+ pure $ [failed $
+ ["TEST FAILURE (BAD REFACTORING)"
+ ,"SRC: " ++ unsafePrettyPrint loc
+ ,"INPUT: " ++ inp] ++ refactorErr
+ | notNull refactorErr]
+
+ if null bad && null badRefactor then passed else sequence_ (bad ++ badRefactor)
+
match "???" _ = True
match (word1 -> ("@Message",msg)) i = ideaHint i == msg
match (word1 -> ("@Note",note)) i = map show (ideaNote i) == [note]
@@ -81,13 +118,16 @@
parseTestFile :: FilePath -> IO [TestCase]
parseTestFile file =
-- we remove all leading # symbols since Yaml only lets us do comments that way
- f Nothing . zip [1..] . map (\x -> fromMaybe x $ stripPrefix "# " x) . lines <$> readFile file
+ f Nothing TestRefactor . zipFrom 1 . map (dropPrefix "# ") . lines <$> readFile file
where
open :: String -> Maybe [Setting]
open line
| "" `isPrefixOf` line =
let suffix = dropPrefix "" line
- config = decodeEither' $ BS.pack suffix
+ config =
+ if isBuiltinYaml file
+ then mapRight getConfigYamlBuiltin $ decodeEither' $ BS.pack suffix
+ else mapRight getConfigYamlUser $ decodeEither' $ BS.pack suffix
in case config of
Left err -> Just []
Right config -> Just $ settingsFromConfigYaml [config]
@@ -96,20 +136,58 @@
shut :: String -> Bool
shut = isPrefixOf ""
- f :: Maybe [Setting] -> [(Int, String)] -> [TestCase]
- f Nothing ((i,x):xs) = f (open x) xs
- f (Just s) ((i,x):xs)
- | shut x = f Nothing xs
- | null x || "-- " `isPrefixOf` x = f (Just s) xs
- | "\\" `isSuffixOf` x, (_,y):ys <- xs = f (Just s) $ (i,init x++"\n"++y):ys
- | otherwise = parseTest file i x s : f (Just s) xs
- f _ [] = []
+ f :: Maybe [Setting] -> Refactor -> [(Int, String)] -> [TestCase]
+ f Nothing _ ((i,x):xs) = f (open x) TestRefactor xs
+ f (Just s) refact ((i,x):xs)
+ | shut x = f Nothing TestRefactor xs
+ | Just (x',_) <- stripInfix "@NoRefactor" x =
+ f (Just s) SkipRefactor ((i, trimEnd x' ++ ['\\' | "\\" `isSuffixOf` x]) : xs)
+ | null x || "-- " `isPrefixOf` x = f (Just s) refact xs
+ | Just x <- stripSuffix "\\" x, (_,y):ys <- xs = f (Just s) refact $ (i,x++"\n"++y):ys
+ | otherwise = parseTest refact file i x s : f (Just s) TestRefactor xs
+ f _ _ [] = []
-parseTest :: String -> Int -> String -> [Setting] -> TestCase
-parseTest file i x = uncurry (TestCase (SrcLoc file i 0)) $ f x
+parseTest :: Refactor -> String -> Int -> String -> [Setting] -> TestCase
+parseTest refact file i x = uncurry (TestCase (mkSrcLoc (mkFastString file) i 0) refact) $ f x
where
f x | Just x <- stripPrefix "" x = first ("--"++) $ f x
- f (' ':'-':'-':xs) | null xs || " " `isPrefixOf` xs = ("", Just $ dropWhile isSpace xs)
+ f (' ':'-':'-':xs) | null xs || " " `isPrefixOf` xs = ("", Just $ trimStart xs)
f (x:xs) = first (x:) $ f xs
f [] = ([], Nothing)
+
+
+-- Returns an empty list if the refactoring test passes, otherwise
+-- returns error messages.
+testRefactor :: Maybe FilePath -> Maybe Idea -> String -> IO [String]
+-- Skip refactoring test if the refactor binary is not found.
+testRefactor Nothing _ _ = pure []
+-- Skip refactoring test if there is no hint.
+testRefactor _ Nothing _ = pure []
+-- Skip refactoring test if the hint has no suggestion (such as "Parse error" or "Avoid restricted function").
+testRefactor _ (Just idea) _ | isNothing (ideaTo idea) = pure []
+-- Skip refactoring test if the hint does not support refactoring.
+testRefactor _ (Just idea) _ | null (ideaRefactoring idea) = pure []
+testRefactor (Just rpath) (Just idea) inp = withTempFile $ \tempInp -> withTempFile $ \tempHints -> do
+ let refact = (show idea, ideaRefactoring idea)
+ -- Ignores spaces and semicolons since unsafePrettyPrint may differ from apply-refact.
+ process = filter (\c -> not (isSpace c) && c /= ';')
+ matched expected g actual = process expected `g` process actual
+ x `isProperSubsequenceOf` y = x /= y && x `isSubsequenceOf` y
+ writeFile tempInp inp
+ writeFile tempHints (show [refact])
+ exitCode <- runRefactoring rpath tempInp tempHints defaultExtensions [] "--inplace"
+ refactored <- readFile tempInp
+ pure $ case exitCode of
+ ExitFailure ec -> ["Refactoring failed: exit code " ++ show ec]
+ ExitSuccess -> case ideaTo idea of
+ -- The hint's suggested replacement is @Just ""@, which means the hint
+ -- suggests removing something from the input. The refactoring output
+ -- should be a proper subsequence of the input.
+ Just "" | not (matched refactored isProperSubsequenceOf inp) ->
+ ["Refactor output is expected to be a proper subsequence of: " ++ inp, "Actual: " ++ refactored]
+ -- The hint has a suggested replacement. The suggested replacement
+ -- should be a substring of the refactoring output.
+ Just to | not (matched to isInfixOf refactored) ->
+ ["Refactor output is expected to contain: " ++ to, "Actual: " ++ refactored]
+ _ -> []
diff --git a/src/Test/InputOutput.hs b/src/Test/InputOutput.hs
--- a/src/Test/InputOutput.hs
+++ b/src/Test/InputOutput.hs
@@ -17,6 +17,8 @@
import System.Exit
import System.IO.Extra
import Prelude
+import Data.Version (showVersion)
+import Paths_hlint (version)
import Test.Util
@@ -24,10 +26,10 @@
testInputOutput :: ([String] -> IO ()) -> Test ()
testInputOutput main = do
xs <- liftIO $ getDirectoryContents "tests"
- xs <- return $ filter ((==) ".test" . takeExtension) xs
+ xs <- pure $ filter ((==) ".test" . takeExtension) xs
forM_ xs $ \file -> do
ios <- liftIO $ parseInputOutputs <$> readFile ("tests" file)
- forM_ (zip [1..] ios) $ \(i,io@InputOutput{..}) -> do
+ forM_ (zipFrom 1 ios) $ \(i,io@InputOutput{..}) -> do
progress
liftIO $ forM_ files $ \(name,contents) -> do
createDirectoryIfMissing True $ takeDirectory name
@@ -48,6 +50,8 @@
where
z = InputOutput "unknown" [] [] "" Nothing
interest x = any (`isPrefixOf` x) ["----","FILE","RUN","OUTPUT","EXIT"]
+ outputTemplateVars = [ ("__VERSION__", showVersion version) ]
+ substituteTemplateVars = mconcatMap (uncurry replace) outputTemplateVars
f io ((stripPrefix "RUN " -> Just flags):xs) = f io{run = splitArgs flags} xs
f io ((stripPrefix "EXIT " -> Just code):xs) = f io{exit = Just $ let i = read code in if i == 0 then ExitSuccess else ExitFailure i} xs
@@ -57,7 +61,7 @@
f io [] = [io | io /= z]
f io (x:xs) = error $ "Unknown test item, " ++ x
- g = first (reverse . dropWhile null . reverse) . break interest
+ g = first (fmap substituteTemplateVars . reverse . dropWhile null . reverse) . break interest
---------------------------------------------------------------------
@@ -71,7 +75,7 @@
handle (\(e::ExitCode) -> writeIORef code e) $
bracket getVerbosity setVerbosity $ const $ setVerbosity Normal >> main run
code <- liftIO $ readIORef code
- (want,got) <- return $ matchStarStar (lines output) got
+ (want,got) <- pure $ matchStarStar (lines output) got
if maybe False (/= code) exit then
failed
@@ -96,7 +100,12 @@
-- | First string may have stars in it (the want)
matchStar :: String -> String -> Bool
matchStar ('*':xs) ys = any (matchStar xs) $ tails ys
-matchStar (x:xs) (y:ys) = x == y && matchStar xs ys
+matchStar ('/':x:xs) ('\\':'\\':ys) | x /= '/' = matchStar (x:xs) ys -- JSON escaped newlines
+matchStar (x:xs) (y:ys) = eq x y && matchStar xs ys
+ where
+ -- allow path differences between Windows and Linux
+ eq '/' y = isPathSeparator y
+ eq x y = x == y
matchStar [] [] = True
matchStar _ _ = False
diff --git a/src/Test/Proof.hs b/src/Test/Proof.hs
deleted file mode 100644
--- a/src/Test/Proof.hs
+++ /dev/null
@@ -1,186 +0,0 @@
-{-# LANGUAGE RecordWildCards, PatternGuards, FlexibleContexts #-}
-
--- | Check the coverage of the hints given a list of Isabelle theorems
-module Test.Proof(proof) where
-
-import Data.Tuple.Extra
-import Control.Applicative
-import Control.Monad
-import Control.Monad.Trans.State
-import Data.Char
-import Data.List.Extra
-import Data.Maybe
-import Data.Function
-import System.FilePath
-import Config.Type
-import HSE.All
-import Prelude
-
-
-data Theorem = Theorem
- {original :: Maybe HintRule
- ,location :: String
- ,lemma :: String
- }
-
-instance Eq Theorem where
- t1 == t2 = lemma t1 == lemma t2
-
-instance Ord Theorem where
- compare t1 t2 = compare (lemma t1) (lemma t2)
-
-instance Show Theorem where
- show Theorem{..} = location ++ ":\n" ++ maybe "" f original ++ lemma ++ "\n"
- where f HintRule{..} = "(* " ++ prettyPrint hintRuleLHS ++ " ==> " ++ prettyPrint hintRuleRHS ++ " *)\n"
-
-proof :: [FilePath] -> [Setting] -> FilePath -> IO ()
-proof reports hints thy = do
- got <- isabelleTheorems (takeFileName thy) <$> readFile thy
- let want = nubOrd $ hintTheorems hints
- let unused = got \\ want
- let missing = want \\ got
- let reasons = map (\x -> (fst $ head x, map snd x)) $ groupBy ((==) `on` fst) $
- sortBy (compare `on` fst) $ map (classifyMissing &&& id) missing
- let summary = table $ let (*) = (,) in
- ["HLint hints" * want
- ,"HOL proofs" * got
- ,"Useful proofs" * (got `intersect` want)
- ,"Unused proofs" * unused
- ,"Unproved hints" * missing] ++
- [(" " ++ name) * ps | (name,ps) <- reasons]
- putStr $ unlines summary
- forM_ reports $ \report -> do
- let out = ("Unused proofs",unused) : map (first ("Unproved hints - " ++)) reasons
- writeFile report $ unlines $ summary ++ "" : concat
- [("== " ++ a ++ " ==") : "" : map show b | (a,b) <- out]
- putStrLn $ "Report written to " ++ report
- where
- table xs = [a ++ replicate (n + 6 - length a - length bb) ' ' ++ bb | (a,b) <- xs, let bb = show $ length b]
- where n = maximum $ map (length . fst) xs
-
-
-missingFuncs :: [(String, String)]
-missingFuncs = let a*b = [(b,a) | b <- words b] in concat
- ["IO" * "putChar putStr print putStrLn getLine getChar getContents hReady hPrint stdin"
- ,"Exit" * "exitSuccess"
- ,"Ord" * "(>) (<=) (>=) (<) compare minimum maximum sort sortBy"
- ,"Show" * "show shows showIntAtBase"
- ,"Read" * "reads read"
- ,"String" * "lines unlines words unwords"
- ,"Monad" * "mapM mapM_ sequence sequence_ msum mplus mzero liftM when unless return evaluate join void (>>=) (<=<) (>=>) forever ap"
- ,"Functor" * "fmap"
- ,"Numeric" * "(+) (*) fromInteger fromIntegral negate log (/) (-) (*) (^^) (^) subtract sqrt even odd"
- ,"Char" * "isControl isPrint isUpper isLower isAlpha isDigit"
- ,"Arrow" * "second first (***) (&&&)"
- ,"Applicative+" * "traverse for traverse_ for_ pure (<|>) (<**>)"
- ,"Exception" * "catch handle catchJust bracket error toException"
- ,"WeakPtr" * "mkWeak"
- ]
-
-
--- | Guess why a theorem is missing
-classifyMissing :: Theorem -> String
-classifyMissing Theorem{original = Just HintRule{..}}
- | _:_ <- [v :: Exp_ | v@Case{} <- universeBi (hintRuleLHS,hintRuleRHS)] = "case"
- | _:_ <- [v :: Exp_ | v@ListComp{} <- universeBi (hintRuleLHS,hintRuleRHS)] = "list-comp"
- | v:_ <- mapMaybe (`lookup` missingFuncs) [prettyPrint (v :: Name S) | v <- universeBi (hintRuleLHS,hintRuleRHS)] = v
-classifyMissing _ = "?unknown"
-
-
--- Extract theorems out of Isabelle code (HLint.thy)
-isabelleTheorems :: FilePath -> String -> [Theorem]
-isabelleTheorems file = find . lexer 1
- where
- find ((i,"lemma"):(_,'\"':lemma):rest) = Theorem Nothing (file ++ ":" ++ show i) lemma : find rest
- find ((i,"lemma"):(_,name):(_,":"):(_,'\"':lemma):rest) = Theorem Nothing (file ++ ":" ++ show i) lemma : find rest
- find ((i,"lemma"):(_,"assumes"):(_,'\"':assumes):(_,"shows"):(_,'\"':lemma):rest) =
- Theorem Nothing (file ++ ":" ++ show i) (assumes ++ " \\ " ++ lemma) : find rest
-
- find ((i,"lemma"):rest) = Theorem Nothing (file ++ ":" ++ show i) "Unsupported lemma format" : find rest
- find (x:xs) = find xs
- find [] = []
-
- lexer i x
- | i `seq` False = []
- | Just x <- stripPrefix "(*" x, (a,b) <- breaks "*)" x = lexer (add a i) b
- | Just x <- stripPrefix "\"" x, (a,b) <- breaks "\"" x = (i,'\"':a) : lexer (add a i) b -- NOTE: drop the final "
- | x:xs <- x, isSpace x = lexer (add [x] i) xs
- | (a@(_:_),b) <- span (\y -> y == '_' || isAlpha y) x = (i,a) : lexer (add a i) b
- lexer i (x:xs) = (i,[x]) : lexer (add [x] i) xs
- lexer i [] = []
-
- add s i = length (filter (== '\n') s) + i
-
- breaks s x | Just x <- stripPrefix s x = ("",x)
- breaks s (x:xs) = let (a,b) = breaks s xs in (x:a,b)
- breaks s [] = ([],[])
-
-
-reparen :: Setting -> Setting
-reparen (SettingMatchExp m@HintRule{..}) = SettingMatchExp m{hintRuleLHS = f False hintRuleLHS, hintRuleRHS = f True hintRuleRHS}
- where f right x = if isLambda x || isIf x || badInfix x then Paren (ann x) x else x
- badInfix (InfixApp _ _ op _) = prettyPrint op `elem` words "|| && ."
- badInfix _ = False
-reparen x = x
-
-
--- Extract theorems out of the hints
-hintTheorems :: [Setting] -> [Theorem]
-hintTheorems xs =
- [ Theorem (Just m) (loc $ ann hintRuleLHS) $ maybe "" assumes hintRuleSide ++ relationship hintRuleNotes a b
- | SettingMatchExp m@HintRule{..} <- map reparen xs, let a = exp1 $ typeclasses hintRuleNotes hintRuleLHS, let b = exp1 hintRuleRHS, a /= b]
- where
- loc (SrcSpanInfo (SrcSpan file ln _ _ _) _) = takeFileName file ++ ":" ++ show ln
-
- subs xs = flip lookup [(reverse b, reverse a) | x <- words xs, let (a,'=':b) = break (== '=') $ reverse x]
- funs = subs "id=ID not=neg or=the_or and=the_and (||)=tror (&&)=trand (++)=append (==)=eq (/=)=neq ($)=dollar"
- ops = subs "||=orelse &&=andalso .=oo ===eq /==neq ++=++ !!=!! $=dollar $!=dollarBang"
- pre = flip elem $ words "eq neq dollar dollarBang"
- cons = subs "True=TT False=FF"
-
- typeclasses hintRuleNotes x = foldr f x hintRuleNotes
- where
- f (ValidInstance cls var) x = evalState (transformM g x) True
- where g v@Var{} | v ~= var = do
- b <- get; put False
- return $ if b then Paren an $ toNamed $ prettyPrint v ++ "::'a::" ++ cls ++ "_sym" else v
- g v = return v :: State Bool Exp_
- f _ x = x
-
- relationship hintRuleNotes a b | any lazier hintRuleNotes = a ++ " \\ " ++ b
- | DecreasesLaziness `elem` hintRuleNotes = b ++ " \\ " ++ a
- | otherwise = a ++ " = " ++ b
- where lazier IncreasesLaziness = True
- lazier RemovesError{} = True
- lazier _ = False
-
- assumes (App _ op var)
- | op ~= "isNat" = "le\\0\\" ++ prettyPrint var ++ " \\ FF \\ "
- | op ~= "isNegZero" = "gt\\0\\" ++ prettyPrint var ++ " \\ FF \\ "
- assumes (App _ op var) | op ~= "isWHNF" = prettyPrint var ++ " \\ \\ \\ "
- assumes _ = ""
-
- exp1 = exp . transformBi unqual
-
- -- Syntax translations
- exp (App _ a b) = exp a ++ "\\" ++ exp b
- exp (Paren _ x) = "(" ++ exp x ++ ")"
- exp (Var _ x) | Just x <- funs $ prettyPrint x = x
- exp (Con _ (Special _ (TupleCon _ _ i))) = "\\" ++ replicate (i-1) ',' ++ "\\"
- exp (Con _ x) | Just x <- cons $ prettyPrint x = x
- exp (Tuple _ _ xs) = "\\" ++ intercalate ", " (map exp xs) ++ "\\"
- exp (If _ a b c) = "If " ++ exp a ++ " then " ++ exp b ++ " else " ++ exp c
- exp (Lambda _ xs y) = "\\ " ++ unwords (map pat xs) ++ ". " ++ exp y
- exp (InfixApp _ x op y) | Just op <- ops $ prettyPrint op =
- if pre op then op ++ "\\" ++ exp (paren x) ++ "\\" ++ exp (paren y) else exp x ++ " " ++ op ++ " " ++ exp y
-
- -- Translations from the Haskell 2010 report
- exp (InfixApp l a (QVarOp _ b) c) = exp $ App l (App l (Var l b) a) c -- S3.4
- exp x@(LeftSection l e op) = let v = fresh x in exp $ Paren l $ Lambda l [toNamed v] $ InfixApp l e op (toNamed v) -- S3.5
- exp x@(RightSection l op e) = let v = fresh x in exp $ Paren l $ Lambda l [toNamed v] $ InfixApp l (toNamed v) op e -- S3.5
- exp x = prettyPrint x
-
- pat (PTuple _ _ xs) = "\\" ++ intercalate ", " (map pat xs) ++ "\\"
- pat x = prettyPrint x
-
- fresh x = head $ ("z":["v" ++ show i | i <- [1..]]) \\ vars x
diff --git a/src/Test/Translate.hs b/src/Test/Translate.hs
deleted file mode 100644
--- a/src/Test/Translate.hs
+++ /dev/null
@@ -1,106 +0,0 @@
-
--- | Translate the hints to Haskell and run with GHC.
-module Test.Translate(testTypeCheck, testQuickCheck) where
-
-import Control.Monad
-import Control.Monad.IO.Class
-import Data.List.Extra
-import System.IO.Extra
-import Data.Maybe
-import System.Process
-import System.Exit
-import System.FilePath
-
-import Config.Type
-import HSE.All
-import Test.Util
-
-
-runMains :: FilePath -> FilePath -> [String] -> Test ()
-runMains datadir tmpdir xs = do
- res <- liftIO $ (if tmpdir == "" then withTempDir else ($ tmpdir)) $ \dir -> do
- ms <- forM (zip [1..] xs) $ \(i,x) -> do
- let m = "I" ++ show i
- writeFile (dir m <.> "hs") $ replace "module Main" ("module " ++ m) x
- return m
- writeFile (dir "Main.hs") $ unlines $
- ["import qualified " ++ m | m <- ms] ++
- ["main = do"] ++
- [" " ++ m ++ ".main" | m <- ms]
- system $ "runhaskell -i" ++ dir ++ " -i" ++ datadir ++ " Main"
- replicateM_ (length xs) $ tested $ res == ExitSuccess
-
-
--- | Given a set of hints, do all the HintRule hints type check
-testTypeCheck :: FilePath -> FilePath -> [[Setting]] -> Test ()
-testTypeCheck = wrap toTypeCheck
-
--- | Given a set of hints, do all the HintRule hints satisfy QuickCheck
-testQuickCheck :: FilePath -> FilePath -> [[Setting]] -> Test ()
-testQuickCheck = wrap toQuickCheck
-
-wrap :: ([HintRule] -> [String]) -> FilePath -> FilePath -> [[Setting]] -> Test ()
-wrap f datadir tmpdir hints = runMains datadir tmpdir [unlines $ body [x | SettingMatchExp x <- xs] | xs <- hints]
- where
- body xs =
- ["{-# LANGUAGE NoMonomorphismRestriction, ExtendedDefaultRules, ScopedTypeVariables, DeriveDataTypeable #-}"
- ,"{-# LANGUAGE FlexibleInstances, UndecidableInstances, OverlappingInstances #-}"
- ,"module Main(main) where"] ++
- concat [map (prettyPrint . hackImport) $ scopeImports $ hintRuleScope x | x <- take 1 xs] ++
- f xs
-
- -- Hack around haskell98 not being compatible with base anymore
- hackImport i@ImportDecl{importAs=Just a,importModule=b}
- | prettyPrint b `elem` words "Maybe List Monad IO Char" = i{importAs=Just b,importModule=a}
- hackImport i = i
-
-
----------------------------------------------------------------------
--- TYPE CHECKING
-
-toTypeCheck :: [HintRule] -> [String]
-toTypeCheck hints =
- ["import HLint_TypeCheck hiding(main)"
- ,"main = return ()"] ++
- ["{-# LINE " ++ show (startLine $ ann rhs) ++ " " ++ show (fileName $ ann rhs) ++ " #-}\n" ++
- prettyPrint (PatBind an (toNamed $ "test" ++ show i) bod Nothing)
- | (i, HintRule _ _ _ lhs rhs side _notes _ghcScope _ghcLhs _ghcRhs _ghcSide) <- zip [1..] hints, "noTypeCheck" `notElem` vars (maybeToList side)
- , let vs = map toNamed $ nubOrd $ filter isUnifyVar $ vars lhs ++ vars rhs
- , let inner = InfixApp an (Paren an lhs) (toNamed "==>") (Paren an rhs)
- , let bod = UnGuardedRhs an $ if null vs then inner else Lambda an vs inner]
-
-
----------------------------------------------------------------------
--- QUICKCHECK
-
-toQuickCheck :: [HintRule] -> [String]
-toQuickCheck hints =
- ["import HLint_QuickCheck hiding(main)"
- ,"default(Maybe Bool,Int,Dbl)"
- ,prettyPrint $ PatBind an (toNamed "main") (UnGuardedRhs an $ toNamed "withMain" $$ Do an tests) Nothing]
- where
- str x = Lit an $ String an x (show x)
- int x = Lit an $ Int an (toInteger x) (show x)
- app = App an
- a $$ b = InfixApp an a (toNamed "$") b
- tests =
- [ Qualifier an $
- Let an (BDecls an [PatBind an (toNamed "t") (UnGuardedRhs an bod) Nothing]) $
- (toNamed "test" `app` str (fileName $ ann rhs) `app` int (startLine $ ann rhs) `app`
- str (prettyPrint lhs ++ " ==> " ++ prettyPrint rhs)) `app` toNamed "t"
- | (i, HintRule _ _ _ lhs rhs side note _ghcScope _ghcLhs _ghcRhs _ghcSide) <- zip [1..] hints, "noQuickCheck" `notElem` vars (maybeToList side)
- , let vs = map (restrict side) $ nubOrd $ filter isUnifyVar $ vars lhs ++ vars rhs
- , let op = if any isRemovesError note then "?==>" else "==>"
- , let inner = InfixApp an (Paren an lhs) (toNamed op) (Paren an rhs)
- , let bod = if null vs then Paren an inner else Lambda an vs inner]
-
- restrict (Just side) v
- | any (=~= App an (toNamed "isNegZero") (toNamed v)) (universe side) = PApp an (toNamed "NegZero") [toNamed v]
- | any (=~= App an (toNamed "isNat") (toNamed v)) (universe side) = PApp an (toNamed "Nat") [toNamed v]
- | any (=~= App an (toNamed "isCompare") (toNamed v)) (universe side) = PApp an (toNamed "Compare") [toNamed v]
- restrict _ v = toNamed v
-
-
-isRemovesError :: Note -> Bool
-isRemovesError RemovesError{} = True
-isRemovesError _ = False
diff --git a/src/Test/Util.hs b/src/Test/Util.hs
--- a/src/Test/Util.hs
+++ b/src/Test/Util.hs
@@ -2,8 +2,7 @@
module Test.Util(
Test, withTests,
- tested, passed, failed, progress,
- addIdeas, getIdeas
+ passed, failed, progress,
) where
import Idea
@@ -12,7 +11,6 @@
import Control.Monad.IO.Class
import Data.IORef
-
data S = S
{failures :: !Int
,total :: !Int
@@ -32,17 +30,7 @@
putStrLn $ if failures == 0
then "Tests passed (" ++ show total ++ ")"
else "Tests failed (" ++ show failures ++ " of " ++ show total ++ ")"
- return (failures, res)
-
-addIdeas :: [Idea] -> Test ()
-addIdeas xs = do
- ref <- Test ask
- liftIO $ modifyIORef' ref $ \s -> s{ideas = xs : ideas s}
-
-getIdeas :: Test [Idea]
-getIdeas = do
- ref <- Test ask
- liftIO $ concat . reverse . ideas <$> readIORef ref
+ pure (failures, res)
progress :: Test ()
progress = liftIO $ putChar '.'
@@ -57,6 +45,3 @@
unless (null xs) $ liftIO $ putStrLn $ unlines $ "" : xs
ref <- Test ask
liftIO $ modifyIORef' ref $ \s -> s{total=total s+1, failures=failures s+1}
-
-tested :: Bool -> Test ()
-tested b = if b then passed else failed []
diff --git a/src/Timing.hs b/src/Timing.hs
--- a/src/Timing.hs
+++ b/src/Timing.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ImportQualifiedPost #-}
module Timing(
timed, timedIO,
@@ -5,7 +6,7 @@
printTimings
) where
-import qualified Data.HashMap.Strict as Map
+import Data.HashMap.Strict qualified as Map
import Control.Exception
import Data.IORef.Extra
import Data.Tuple.Extra
@@ -14,6 +15,7 @@
import System.Console.CmdArgs.Verbosity
import System.Time.Extra
import System.IO.Unsafe
+import System.IO
type Category = String
@@ -39,11 +41,13 @@
timedIO :: Category -> Item -> IO a -> IO a
timedIO c i x = if not useTimings then x else do
let quiet = c == "Hint"
- unless quiet $ whenLoud $ putStr $ "Performing " ++ c ++ " of " ++ i ++ "... "
+ unless quiet $ whenLoud $ do
+ putStr $ "# " ++ c ++ " of " ++ i ++ "... "
+ hFlush stdout
(time, x) <- duration x
- atomicModifyIORef' timings $ \mp -> (Map.insertWith (+) (c, i) time mp, ())
+ atomicModifyIORef'_ timings $ Map.insertWith (+) (c, i) time
unless quiet $ whenLoud $ putStrLn $ "took " ++ showDuration time
- return x
+ pure x
startTimings :: IO ()
startTimings = do
diff --git a/src/Util.hs b/src/Util.hs
--- a/src/Util.hs
+++ b/src/Util.hs
@@ -1,22 +1,20 @@
{-# LANGUAGE ExistentialQuantification, Rank2Types #-}
module Util(
- parseExtensions,
- configExtensions,
forceList,
gzip, universeParentBi,
exitMessage, exitMessageImpure,
- getContentsUTF8
+ getContentsUTF8, wildcardMatch
) where
-import Data.List
import System.Exit
import System.IO
import System.IO.Unsafe
import Unsafe.Coerce
import Data.Data
-import Data.Generics.Uniplate.Operations
-import Language.Haskell.Exts.Extension
+import Data.Generics.Uniplate.DataOnly
+import System.FilePattern
+import Data.List.Extra
---------------------------------------------------------------------
@@ -60,37 +58,31 @@
---------------------------------------------------------------------
-- DATA.GENERICS.UNIPLATE.OPERATIONS
-universeParent :: Uniplate a => a -> [(Maybe a, a)]
+universeParent :: Data a => a -> [(Maybe a, a)]
universeParent x = (Nothing,x) : f x
where
- f :: Uniplate a => a -> [(Maybe a, a)]
+ f :: Data a => a -> [(Maybe a, a)]
f x = concat [(Just x, y) : f y | y <- children x]
-universeParentBi :: Biplate a b => a -> [(Maybe b, b)]
+universeParentBi :: (Data a, Data b) => a -> [(Maybe b, b)]
universeParentBi = concatMap universeParent . childrenBi
---------------------------------------------------------------------
--- LANGUAGE.HASKELL.EXTS.EXTENSION
-
--- | Extensions we turn on by default when parsing. Aim to parse as many files as we can.
-parseExtensions :: [Extension]
-parseExtensions = [e | e@EnableExtension{} <- knownExtensions] \\ map EnableExtension badExtensions
-
--- | Extensions we turn on when reading config files, don't have to deal with the whole world
--- of variations - in particular, we might require spaces in some places.
-configExtensions :: [Extension]
-configExtensions = [e | e@EnableExtension{} <- knownExtensions] \\ map EnableExtension reallyBadExtensions
-
-badExtensions = reallyBadExtensions ++
- [Arrows -- steals proc
- ,UnboxedTuples, UnboxedSums -- breaks (#) lens operator
- ,QuasiQuotes -- breaks [x| ...], making whitespace free list comps break
- ,DoRec, RecursiveDo -- breaks rec
- ,TypeApplications -- HSE fails on @ patterns
- ]
+-- SYSTEM.FILEPATTERN
-reallyBadExtensions =
- [TransformListComp -- steals the group keyword
- ,XmlSyntax, RegularPatterns -- steals a-b and < operators
- ]
+-- | Returns true if the pattern matches the string. For example:
+--
+-- >>> let isSpec = wildcardMatch "**.*Spec"
+-- >>> isSpec "Example"
+-- False
+-- >>> isSpec "ExampleSpec"
+-- True
+-- >>> isSpec "Namespaced.ExampleSpec"
+-- True
+-- >>> isSpec "Deeply.Nested.ExampleSpec"
+-- True
+--
+-- See this issue for details: .
+wildcardMatch :: FilePattern -> String -> Bool
+wildcardMatch p m = let f = replace "." "/" in f p ?== f m
diff --git a/tests/bracket.test b/tests/bracket.test
new file mode 100644
--- /dev/null
+++ b/tests/bracket.test
@@ -0,0 +1,29 @@
+---------------------------------------------------------------------
+RUN tests/bracket-slice.hs
+FILE tests/bracket-slice.hs
+
+fAnd :: [a -> Bool] -> a -> Bool
+fAnd fs x = all ($x) fs
+
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/bracket-slice-spaced.hs
+FILE tests/bracket-slice-spaced.hs
+
+fAnd :: [a -> Bool] -> a -> Bool
+fAnd fs x = all ($ x) fs
+
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/bracket-slice-plus.hs
+FILE tests/bracket-slice-plus.hs
+
+incAll :: [Int] -> Int -> [Int]
+incAll ys x = map (+x) fs
+
+OUTPUT
+No hints
diff --git a/tests/cmdline.test b/tests/cmdline.test
new file mode 100644
--- /dev/null
+++ b/tests/cmdline.test
@@ -0,0 +1,29 @@
+---------------------------------------------------------------------
+RUN lint tests/cmdline-lint.hs
+FILE tests/cmdline-lint.hs
+
+foo = map f (map g xs)
+
+OUTPUT
+tests/cmdline-lint.hs:2:7-22: Suggestion: Use map once
+Found:
+ map f (map g xs)
+Perhaps:
+ map (f . g) xs
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/cmdline-bare.hs
+FILE tests/cmdline-bare.hs
+
+foo = map f (map g xs)
+
+OUTPUT
+tests/cmdline-bare.hs:2:7-22: Suggestion: Use map once
+Found:
+ map f (map g xs)
+Perhaps:
+ map (f . g) xs
+
+1 hint
diff --git a/tests/cpp.test b/tests/cpp.test
new file mode 100644
--- /dev/null
+++ b/tests/cpp.test
@@ -0,0 +1,167 @@
+---------------------------------------------------------------------
+RUN tests/cpp-full.hs
+FILE tests/cpp-full.hs
+/* this is a test */
+
+main = putStrLn $ show "Hello"
+OUTPUT
+tests/cpp-full.hs:3:8-30: Warning: Use print
+Found:
+ putStrLn $ show "Hello"
+Perhaps:
+ print "Hello"
+
+1 hint
+
+---------------------------------------------------------------------
+RUN -XNoCPP tests/cpp-none.hs
+FILE tests/cpp-none.hs
+#include "Any/File.h"
+
+main = print "Hello"
+EXIT 0
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN -XNoCPP tests/cpp-must-not-run.hs
+FILE tests/cpp-must-not-run.hs
+{-
+#error Cpp has run
+-}
+main = undefined
+EXIT 0
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN --cpp-define FOO tests/cpp-ext-enable.hs
+FILE tests/cpp-ext-enable.hs
+{-# LANGUAGE CPP #-}
+#if defined(FOO)
+{-# LANGUAGE Foo #-}
+#endif
+main = undefined
+EXIT 1
+OUTPUT
+tests/cpp-ext-enable.hs:1:1: Error: Parse error: tests/cpp-ext-enable.hs:3:14: error: [GHC-46537]
+ Unsupported extension: Foo
+Found:
+ {-# LANGUAGE CPP #-}
+
+ {-# LANGUAGE Foo #-}
+
+ main = undefined
+
+1 error
+
+---------------------------------------------------------------------
+RUN tests/cpp-ext-disable.hs
+FILE tests/cpp-ext-disable.hs
+{-# LANGUAGE CPP #-}
+#if defined(FOO)
+{-# LANGUAGE Foo #-}
+#endif
+main = undefined
+EXIT 1
+OUTPUT
+tests/cpp-ext-disable.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN --cpp-simple tests/cpp-simple.hs
+FILE tests/cpp-simple.hs
+#include "Any/File.h"
+
+main = print "Hello"
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/cpp-file1.hs
+FILE tests/cpp-file1.hs
+import Network.Wai
+#if MIN_VERSION_wai(2, 0, 0)
+import Network.Wai.Internal
+#endif
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN --cpp-file=tests/cabal_macros.h tests/cpp-file2.hs
+FILE tests/cabal_macros.h
+#define MIN_VERSION_wai(a,b,c) 1
+FILE tests/cpp-file2.hs
+import Network.Wai
+#if MIN_VERSION_wai(2, 0, 0)
+import Network.Wai.Internal
+#endif
+foo = map f . map g
+OUTPUT
+tests/cpp-file2.hs:5:7-19: Suggestion: Use map once
+Found:
+ map f . map g
+Perhaps:
+ map (f . g)
+
+1 hint
+
+---------------------------------------------------------------------
+RUN --cpp-simple tests/cpp-file3.hs
+FILE tests/cpp-file3.hs
+import Network.Wai
+#if MIN_VERSION_wai(2, 0, 0)
+import Network.Wai.Internal
+#endif
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN --cpp-simple tests/cpp-file4.hs
+FILE tests/cpp-file4.hs
+import Network.Wai
+#if defined(MIN_VERSION_wai) && MIN_VERSION_wai(2, 0, 0)
+import Network.Wai.Internal
+#endif
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/cpp-file5.hs
+FILE tests/cpp-file5.hs
+{-# LANGUAGE CPP #-}
+main =
+#if __GLASGOW_HASKELL__ > 800
+ print __GLASGOW_HASKELL__
+#else
+ putStrLn $ show __GLASGOW_HASKELL__
+#endif
+OUTPUT
+tests/cpp-file5.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN --cpp-define "__GLASGOW_HASKELL__=123" tests/cpp-file6.hs
+FILE tests/cpp-file6.hs
+{-# LANGUAGE CPP #-}
+main =
+#if __GLASGOW_HASKELL__ == 123
+ print __GLASGOW_HASKELL__
+#else
+ putStrLn $ show __GLASGOW_HASKELL__
+#endif
+OUTPUT
+tests/cpp-file6.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
diff --git a/tests/cross.test b/tests/cross.test
new file mode 100644
--- /dev/null
+++ b/tests/cross.test
@@ -0,0 +1,25 @@
+---------------------------------------------------------------------
+RUN tests/cross.hs1 tests/cross.hs2 --cross
+FILE tests/cross.hs1
+
+module B(bar) where
+
+
+bar = 1
+ where
+ a = 1
+ b = 2
+ c = 3
+
+FILE tests/cross.hs2
+
+module A(foo) where
+
+foo = 1
+ where
+ a = 1
+ b = 2
+ c = 3
+
+OUTPUT
+No hints
diff --git a/tests/do-block.test b/tests/do-block.test
new file mode 100644
--- /dev/null
+++ b/tests/do-block.test
@@ -0,0 +1,17 @@
+---------------------------------------------------------------------
+RUN tests/do-block.hs --hint=data/do-block.yaml
+FILE tests/do-block.hs
+h x = case f x of
+ Just n -> g n
+ Nothing -> Nothing
+OUTPUT
+tests/do-block.hs:(1,7)-(3,20): Warning: Redundant Nothing
+Found:
+ case f x of
+ Just n -> g n
+ Nothing -> Nothing
+Perhaps:
+ do n <- f x
+ g n
+
+1 hint
diff --git a/tests/find.test b/tests/find.test
new file mode 100644
--- /dev/null
+++ b/tests/find.test
@@ -0,0 +1,42 @@
+---------------------------------------------------------------------
+RUN --find=tests/find.hs
+FILE tests/find.hs
+{-# LANGUAGE CPP, ExistentialQuantification, Rank2Types #-}
+
+module Util where
+
+import Control.Arrow
+import Control.Monad.Trans.State
+import Data.Char
+import Data.Function
+
+infixr 4 %^&, `wheeeee`
+
+instance Foo a where
+ bar = baz + qux
+
+listM' :: Monad m => [a] -> m [a]
+listM' x = length x `seq` return x
+
+notNull = not . null
+
+headDef :: a -> [a] -> a
+headDef x [] = x
+headDef x (y:ys) = y
+
+isLeft Left{} = True; isLeft _ = False
+isRight = not . isLeft
+
+swap :: (a,b) -> (b,a)
+swap (a,b) = (b,a)
+
+defaultExtensions = knownExtensions \\ badExtensions
+OUTPUT
+# hints found in tests/find.hs
+- fixity: "infixr 4 %^&"
+- fixity: "infixr 4 `wheeeee`"
+- warn: {lhs: "baz + qux", rhs: "bar"}
+- warn: {lhs: "length a `seq` return a", rhs: "listM' a"}
+- warn: {lhs: "not (null a)", rhs: "notNull a"}
+- warn: {lhs: "not (isLeft a)", rhs: "isRight a"}
+- warn: {lhs: "knownExtensions \\\\ badExtensions", rhs: "defaultExtensions"}
diff --git a/tests/flag-extension.test b/tests/flag-extension.test
new file mode 100644
--- /dev/null
+++ b/tests/flag-extension.test
@@ -0,0 +1,31 @@
+---------------------------------------------------------------------
+RUN tests/directory
+FILE tests/directory/File1.hs
+ foo = map f . map g
+FILE tests/directory/File2.lhs
+> foo = map f . map g
+OUTPUT
+tests/directory/File1.hs:1:8-20: Suggestion: Use map once
+Found:
+ map f . map g
+Perhaps:
+ map (f . g)
+
+tests/directory/File2.lhs:1:9-21: Suggestion: Use map once
+Found:
+ map f . map g
+Perhaps:
+ map (f . g)
+
+2 hints
+
+---------------------------------------------------------------------
+RUN tests/directory --extension=lhs
+OUTPUT
+tests/directory/File2.lhs:1:9-21: Suggestion: Use map once
+Found:
+ map f . map g
+Perhaps:
+ map (f . g)
+
+1 hint
diff --git a/tests/flag-ignore-suggestions.test b/tests/flag-ignore-suggestions.test
new file mode 100644
--- /dev/null
+++ b/tests/flag-ignore-suggestions.test
@@ -0,0 +1,38 @@
+---------------------------------------------------------------------
+RUN tests/flag-ignore-suggestions-1.hs --ignore-suggestions
+FILE tests/flag-ignore-suggestions-1.hs
+main = map f $ map g xs
+OUTPUT
+No hints
+
+EXIT 0
+---------------------------------------------------------------------
+RUN tests/flag-ignore-suggestions-2.hs --ignore-suggestions
+FILE tests/flag-ignore-suggestions-2.hs
+foo = (+1)
+bar x = foo x
+main = map f $ map g xs
+OUTPUT
+tests/flag-ignore-suggestions-2.hs:2:1-13: Warning: Eta reduce
+Found:
+ bar x = foo x
+Perhaps:
+ bar = foo
+
+1 hint
+
+EXIT 1
+---------------------------------------------------------------------
+RUN tests/flag-ignore-suggestions-3.hs --ignore-suggestions --show
+FILE tests/flag-ignore-suggestions-3.hs
+main = map f $ map g xs
+OUTPUT
+tests/flag-ignore-suggestions-3.hs:1:8-23: Suggestion: Use map once
+Found:
+ map f $ map g xs
+Perhaps:
+ map (f . g) xs
+
+1 hint
+
+EXIT 1
diff --git a/tests/flag-no-summary.test b/tests/flag-no-summary.test
new file mode 100644
--- /dev/null
+++ b/tests/flag-no-summary.test
@@ -0,0 +1,18 @@
+---------------------------------------------------------------------
+RUN tests/flag-no-summary1.hs --no-summary
+FILE tests/flag-no-summary1.hs
+main = map f $ map g xs
+OUTPUT
+tests/flag-no-summary1.hs:1:8-23: Suggestion: Use map once
+Found:
+ map f $ map g xs
+Perhaps:
+ map (f . g) xs
+
+EXIT 1
+---------------------------------------------------------------------
+RUN tests/flag-no-summary2.hs --no-summary
+FILE tests/flag-no-summary2.hs
+main = pure ()
+OUTPUT
+EXIT 0
diff --git a/tests/flag-only.test b/tests/flag-only.test
new file mode 100644
--- /dev/null
+++ b/tests/flag-only.test
@@ -0,0 +1,30 @@
+---------------------------------------------------------------------
+RUN tests/flag-only-one-arg.hs --only="Redundant bracket"
+FILE tests/flag-only-one-arg.hs
+foo xs = if length xs == 0 then 42 else (666) -- should result in 2 suggestions
+OUTPUT
+tests/flag-only-one-arg.hs:1:41-45: Warning: Redundant bracket
+Found:
+ (666)
+Perhaps:
+ 666
+
+1 hint
+---------------------------------------------------------------------
+RUN tests/flag-only-many-args.hs --only="Redundant bracket" --only="Use ++"
+FILE tests/flag-only-many-args.hs
+foo xs = if length xs == 0 then concat ["foo", "bar"] else (666) -- should result in 3 suggestions
+OUTPUT
+tests/flag-only-many-args.hs:1:33-53: Suggestion: Use ++
+Found:
+ concat ["foo", "bar"]
+Perhaps:
+ "foo" ++ "bar"
+
+tests/flag-only-many-args.hs:1:60-64: Warning: Redundant bracket
+Found:
+ (666)
+Perhaps:
+ 666
+
+2 hints
diff --git a/tests/flag-quiet.test b/tests/flag-quiet.test
new file mode 100644
--- /dev/null
+++ b/tests/flag-quiet.test
@@ -0,0 +1,6 @@
+---------------------------------------------------------------------
+RUN tests/flag-quiet.hs --quiet
+FILE tests/flag-quiet.hs
+main = map f $ map g xs
+OUTPUT
+EXIT 1
diff --git a/tests/flag-with-group.test b/tests/flag-with-group.test
new file mode 100644
--- /dev/null
+++ b/tests/flag-with-group.test
@@ -0,0 +1,22 @@
+---------------------------------------------------------------------
+FILE tests/flag-with-group.hs
+foo = map (+1) . maybe mempty reverse
+RUN "--with-group=generalise" tests/flag-with-group.hs
+OUTPUT
+tests/flag-with-group.hs:1:7-9: Warning: Use fmap
+Found:
+ map
+Perhaps:
+ fmap
+
+1 hint
+---------------------------------------------------------------------
+RUN "--with-group=generalise-for-conciseness" tests/flag-with-group.hs
+OUTPUT
+tests/flag-with-group.hs:1:18-29: Warning: Use foldMap
+Found:
+ maybe mempty
+Perhaps:
+ foldMap
+
+1 hint
diff --git a/tests/hint.test b/tests/hint.test
new file mode 100644
--- /dev/null
+++ b/tests/hint.test
@@ -0,0 +1,241 @@
+---------------------------------------------------------------------
+RUN tests/newtype-derive.hs --hint=data/hlint.yaml
+FILE tests/newtype-derive.hs
+{-# LANGUAGE DeriveTraversable #-} -- Implies DeriveFoldable and DeriveFunctor
+{-# LANGUAGE DeriveDataTypeable #-}
+module Test(A) where
+
+import Data.Foldable (Foldable)
+import Data.Traversable (Traversable)
+import Data.Typeable (Typeable)
+
+newtype A f = A f
+ deriving (Foldable, Functor, Traversable, Typeable)
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/note.hs
+FILE tests/note.hs
+{-# LANGUAGE RecordWildCards #-}
+
+module Sample(test) where
+
+test xs = length xs == 0
+OUTPUT
+tests/note.hs:1:1-32: Warning: Unused LANGUAGE pragma
+Found:
+ {-# LANGUAGE RecordWildCards #-}
+Perhaps you should remove it.
+Note: may require `{-# LANGUAGE DisambiguateRecordFields #-}` adding to the top of the file
+
+tests/note.hs:5:11-24: Suggestion: Use null
+Found:
+ length xs == 0
+Perhaps:
+ null xs
+Note: increases laziness
+
+2 hints
+
+---------------------------------------------------------------------
+RUN tests/brackets.hs
+FILE tests/brackets.hs
+test = if isNothing x then (-1.0) else fromJust x
+OUTPUT
+tests/brackets.hs:1:8-49: Warning: Use fromMaybe
+Found:
+ if isNothing x then (- 1.0) else fromJust x
+Perhaps:
+ fromMaybe (- 1.0) x
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/typesig-ignore.hs
+FILE tests/typesig-ignore.hs
+-- Bug #563
+module Foo(foobar) where
+{-# ANN foobar "HLint: ignore Use String" #-}
+
+foobar :: [Char]
+foobar = []
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/typesig-ignore2.hs
+FILE tests/typesig-ignore2.hs
+-- Bug #563
+module Foo(foobar) where
+{-# HLINT ignore foobar "Use String" #-}
+
+foobar :: [Char]
+foobar = []
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/restricted-module.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-module.lhs
+> import Restricted.Module
+OUTPUT
+tests/restricted-module.lhs:1:3-26: Warning: Avoid restricted module
+Found:
+ import Restricted.Module
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-module-message.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-module-message.lhs
+> import Restricted.Module.Message
+OUTPUT
+tests/restricted-module-message.lhs:1:3-34: Warning: Avoid restricted module
+Found:
+ import Restricted.Module.Message
+Note: Custom message
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-badidents-bad.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-badidents-bad.lhs
+> import Restricted.Module.BadIdents (bad)
+OUTPUT
+tests/restricted-badidents-bad.lhs:1:3-42: Warning: Avoid restricted identifiers
+Found:
+ import Restricted.Module.BadIdents ( bad )
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-badidents-multibad.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-badidents-multibad.lhs
+> import Restricted.Module.BadIdents (bad, good)
+OUTPUT
+tests/restricted-badidents-multibad.lhs:1:3-48: Warning: Avoid restricted identifiers
+Found:
+ import Restricted.Module.BadIdents ( bad, good )
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-badidents-valid.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-badidents-valid.lhs
+> import Restricted.Module.BadIdents (good)
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/restricted-badidents-universal.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-badidents-universal.lhs
+> import Restricted.Module.BadIdents
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/restricted-onlyidents-bad.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-onlyidents-bad.lhs
+> import Restricted.Module.OnlyIdents (bad)
+OUTPUT
+tests/restricted-onlyidents-bad.lhs:1:3-43: Warning: Avoid restricted identifiers
+Found:
+ import Restricted.Module.OnlyIdents ( bad )
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-onlyidents-multibad.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-onlyidents-multibad.lhs
+> import Restricted.Module.OnlyIdents (bad, good)
+OUTPUT
+tests/restricted-onlyidents-multibad.lhs:1:3-49: Warning: Avoid restricted identifiers
+Found:
+ import Restricted.Module.OnlyIdents ( bad, good )
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-onlyidents-valid.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-onlyidents-valid.lhs
+> import Restricted.Module.OnlyIdents (good)
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/restricted-onlyidents-universal.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-onlyidents-universal.lhs
+> import Restricted.Module.OnlyIdents
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/restricted-function.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-function.lhs
+> main = restricted ()
+OUTPUT
+tests/restricted-function.lhs:1:10-19: Warning: Avoid restricted function
+Found:
+ restricted
+Note: may break the code
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-function-message.lhs --hint=data/test-restrict.yaml
+FILE tests/restricted-function-message.lhs
+> main = restrictedMessage ()
+OUTPUT
+tests/restricted-function-message.lhs:1:10-26: Warning: Avoid restricted function
+Found:
+ restrictedMessage
+Note: Custom message
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/restricted-extension.hs --hint=data/test-restrict.yaml
+FILE tests/restricted-extension.hs
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+module Test(A) where
+
+import Data.Foldable (Foldable)
+import Data.Traversable (Traversable)
+import Data.Typeable (Typeable)
+
+newtype A f = A f
+ deriving (Foldable, Functor, Traversable, Typeable)
+OUTPUT
+OUTPUT
+tests/restricted-extension.hs:1:1-31: Warning: Unused LANGUAGE pragma
+Found:
+ {-# LANGUAGE DeriveFoldable #-}
+Perhaps you should remove it.
+Note: Extension DeriveFoldable is implied by DeriveTraversable
+
+tests/restricted-extension.hs:2:1-30: Warning: Unused LANGUAGE pragma
+Found:
+ {-# LANGUAGE DeriveFunctor #-}
+Perhaps you should remove it.
+Note: Extension DeriveFunctor is implied by DeriveTraversable
+
+tests/restricted-extension.hs:2:1-30: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE DeriveFunctor #-}
+Note: may break the code
+
+tests/restricted-extension.hs:3:1-34: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE DeriveTraversable #-}
+Note: Custom message
+
+4 hints
diff --git a/tests/hintrule-implies-classify.test b/tests/hintrule-implies-classify.test
new file mode 100644
--- /dev/null
+++ b/tests/hintrule-implies-classify.test
@@ -0,0 +1,12 @@
+---------------------------------------------------------------------
+RUN tests/hintrule-implies-classify.hs --hint=data/hintrule-implies-classify.yaml
+FILE tests/hintrule-implies-classify.hs
+x = mapM print [1, 2, 3]
+OUTPUT
+tests/hintrule-implies-classify.hs:1:5-8: Warning: Use traverse
+Found:
+ mapM
+Perhaps:
+ traverse
+
+1 hint
diff --git a/tests/import_style.test b/tests/import_style.test
new file mode 100644
--- /dev/null
+++ b/tests/import_style.test
@@ -0,0 +1,129 @@
+---------------------------------------------------------------------
+RUN tests/importStyle-1.hs --hint=data/import_style.yaml
+FILE tests/importStyle-1.hs
+import HypotheticalModule1
+import HypotheticalModule2
+import HypotheticalModule3
+import qualified HypotheticalModule3.SomeModule
+import HypotheticalModule3.SomeModule qualified
+import qualified HypotheticalModule3.OtherSubModule
+OUTPUT
+tests/importStyle-1.hs:1:1-26: Warning: Avoid restricted alias
+Found:
+ import HypotheticalModule1
+Perhaps:
+ import HypotheticalModule1 as HM1
+Note: may break the code
+
+tests/importStyle-1.hs:2:1-26: Warning: HypotheticalModule2 should be imported qualified or with an explicit import list
+Found:
+ import HypotheticalModule2
+Perhaps:
+ import qualified HypotheticalModule2
+Note: may break the code
+
+tests/importStyle-1.hs:3:1-26: Warning: HypotheticalModule3 should be imported qualified
+Found:
+ import HypotheticalModule3
+Perhaps:
+ import qualified HypotheticalModule3
+Note: may break the code
+
+tests/importStyle-1.hs:4:1-47: Warning: HypotheticalModule3.SomeModule should be imported unqualified
+Found:
+ import qualified HypotheticalModule3.SomeModule
+Perhaps:
+ import HypotheticalModule3.SomeModule
+Note: may break the code
+
+tests/importStyle-1.hs:5:1-47: Warning: HypotheticalModule3.SomeModule should be imported unqualified
+Found:
+ import HypotheticalModule3.SomeModule qualified
+Perhaps:
+ import HypotheticalModule3.SomeModule
+Note: may break the code
+
+tests/importStyle-1.hs:6:1-51: Warning: HypotheticalModule3.OtherSubModule should be imported post-qualified or unqualified
+Found:
+ import qualified HypotheticalModule3.OtherSubModule
+Perhaps:
+ import HypotheticalModule3.OtherSubModule qualified
+Note: may break the code
+
+6 hints
+
+---------------------------------------------------------------------
+RUN tests/importStyle-2.hs --hint=data/import_style.yaml
+FILE tests/importStyle-2.hs
+import HypotheticalModule1 as HM1
+import qualified HypotheticalModule2
+import HypotheticalModule2 (a, b, c, d)
+import qualified HypotheticalModule3
+import HypotheticalModule3.SomeModule
+import HypotheticalModule3.OtherSubModule qualified
+import HypotheticalModule3.OtherSubModule
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/importStyle-postqual-pos.hs --hint=data/import_style.yaml -XImportQualifiedPost
+FILE tests/importStyle-postqual-pos.hs
+import HypotheticalModule1 qualified as HM1
+import HypotheticalModule2 qualified
+import HypotheticalModule2 qualified as Arbitrary
+import HypotheticalModule3 qualified
+import HypotheticalModule3 qualified as Arbitrary
+import HypotheticalModule4 qualified as HM4
+import HypotheticalModule5 qualified
+import HypotheticalModule5 qualified as HM5
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/importStyle-postqual-neg.hs --hint=data/import_style.yaml -XImportQualifiedPost
+FILE tests/importStyle-postqual-neg.hs
+import HypotheticalModule1 qualified
+import qualified HypotheticalModule4
+import qualified HypotheticalModule4 as Verbotten
+import qualified HypotheticalModule4 as HM4
+import HypotheticalModule5 as HM5
+import qualified HypotheticalModule5
+
+OUTPUT
+tests/importStyle-postqual-neg.hs:1:1-36: Warning: Avoid restricted alias
+Found:
+ import HypotheticalModule1 qualified
+Perhaps:
+ import HypotheticalModule1 qualified as HM1
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:2:1-36: Warning: Avoid restricted alias
+Found:
+ import qualified HypotheticalModule4
+Perhaps:
+ import qualified HypotheticalModule4 as HM4
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:3:1-49: Warning: Avoid restricted alias
+Found:
+ import qualified HypotheticalModule4 as Verbotten
+Perhaps:
+ import qualified HypotheticalModule4 as HM4
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:5:1-33: Warning: HypotheticalModule5 should be imported post-qualified
+Found:
+ import HypotheticalModule5 as HM5
+Perhaps:
+ import HypotheticalModule5 qualified as HM5
+Note: may break the code
+
+tests/importStyle-postqual-neg.hs:6:1-36: Warning: HypotheticalModule5 should be imported post-qualified
+Found:
+ import qualified HypotheticalModule5
+Perhaps:
+ import HypotheticalModule5 qualified
+Note: may break the code
+
+5 hints
+---------------------------------------------------------------------
diff --git a/tests/json.test b/tests/json.test
new file mode 100644
--- /dev/null
+++ b/tests/json.test
@@ -0,0 +1,40 @@
+---------------------------------------------------------------------
+RUN tests/json-none.hs --json
+FILE tests/json-none.hs
+foo = (+1)
+OUTPUT
+[]
+
+---------------------------------------------------------------------
+RUN tests/json-one.hs --json
+FILE tests/json-one.hs
+foo = (+1)
+bar x = foo x
+OUTPUT
+[{"module":["Main"],"decl":["bar"],"severity":"Warning","hint":"Eta reduce","file":"tests/json-one.hs","startLine":2,"startColumn":1,"endLine":2,"endColumn":14,"from":"bar x = foo x","to":"bar = foo","note":[],"refactorings":"[Replace {rtype = Decl, pos = SrcSpan {startLine = 2, startCol = 1, endLine = 2, endCol = 14}, subts = [(\"body\",SrcSpan {startLine = 2, startCol = 9, endLine = 2, endCol = 12})], orig = \"bar = body\"}]"}]
+
+---------------------------------------------------------------------
+RUN tests/json-two.hs --json
+FILE tests/json-two.hs
+foo = (+1)
+bar x = foo x
+baz = getLine >>= pure . upper
+OUTPUT
+[{"module":["Main"],"decl":["bar"],"severity":"Warning","hint":"Eta reduce","file":"tests/json-two.hs","startLine":2,"startColumn":1,"endLine":2,"endColumn":14,"from":"bar x = foo x","to":"bar = foo","note":[],"refactorings":"[Replace {rtype = Decl, pos = SrcSpan {startLine = 2, startCol = 1, endLine = 2, endCol = 14}, subts = [(\"body\",SrcSpan {startLine = 2, startCol = 9, endLine = 2, endCol = 12})], orig = \"bar = body\"}]"}
+,{"module":["Main"],"decl":["baz"],"severity":"Suggestion","hint":"Use <&>","file":"tests/json-two.hs","startLine":3,"startColumn":7,"endLine":3,"endColumn":31,"from":"getLine >>= pure . upper","to":"getLine Data.Functor.<&> upper","note":[],"refactorings":"[Replace {rtype = Expr, pos = SrcSpan {startLine = 3, startCol = 7, endLine = 3, endCol = 31}, subts = [(\"f\",SrcSpan {startLine = 3, startCol = 26, endLine = 3, endCol = 31}),(\"m\",SrcSpan {startLine = 3, startCol = 7, endLine = 3, endCol = 14})], orig = \"m Data.Functor.<&> f\"}]"}]
+
+---------------------------------------------------------------------
+RUN tests/json-parse-error.hs --json
+FILE tests/json-parse-error.hs
+@
+OUTPUT
+[{"module":[],"decl":[],"severity":"Error","hint":"Parse error: on input `@'","file":"tests/json-parse-error.hs","startLine":1,"startColumn":1,"endLine":1,"endColumn":2,"from":"> @\n","to":null,"note":[],"refactorings":"[]"}]
+
+---------------------------------------------------------------------
+RUN tests/json-note.hs --json
+FILE tests/json-note.hs
+foo = any (a ==)
+bar = foldl (&&) True
+OUTPUT
+[{"module":["Main"],"decl":["foo"],"severity":"Warning","hint":"Use elem","file":"tests/json-note.hs","startLine":1,"startColumn":7,"endLine":1,"endColumn":17,"from":"any (a ==)","to":"elem a","note":["requires a valid `Eq` instance for `a`"],"refactorings":"[Replace {rtype = Expr, pos = SrcSpan {startLine = 1, startCol = 7, endLine = 1, endCol = 17}, subts = [(\"a\",SrcSpan {startLine = 1, startCol = 12, endLine = 1, endCol = 13})], orig = \"elem a\"}]"}
+,{"module":["Main"],"decl":["bar"],"severity":"Warning","hint":"Use and","file":"tests/json-note.hs","startLine":2,"startColumn":7,"endLine":2,"endColumn":22,"from":"foldl (&&) True","to":"and","note":["increases laziness"],"refactorings":"[Replace {rtype = Expr, pos = SrcSpan {startLine = 2, startCol = 7, endLine = 2, endCol = 22}, subts = [], orig = \"and\"}]"}]
diff --git a/tests/lhs.test b/tests/lhs.test
new file mode 100644
--- /dev/null
+++ b/tests/lhs.test
@@ -0,0 +1,47 @@
+---------------------------------------------------------------------
+RUN tests/lhs-line-numbers.lhs
+FILE tests/lhs-line-numbers.lhs
+BUG 331
+
+> main = print ([1] ++ [2, 3])
+OUTPUT
+tests/lhs-line-numbers.lhs:3:17-29: Suggestion: Use :
+Found:
+ [1] ++ [2, 3]
+Perhaps:
+ 1 : [2, 3]
+
+1 hint
+
+---------------------------------------------------------------------
+RUN tests/lhs-line-numbers2.lhs
+FILE tests/lhs-line-numbers2.lhs
+BUG 331
+% Blah1
+% Blah2
+% Blah3
+
+\begin{code}
+module
+\end{code}
+OUTPUT
+tests/lhs-line-numbers2.lhs:10:1: Error: Parse error: possibly incorrect indentation or mismatched brackets
+Found:
+ \end{code}
+
+ >
+
+1 error
+
+---------------------------------------------------------------------
+RUN tests/lhs-first-line.lhs
+FILE tests/lhs-first-line.lhs
+> main = print ([1] ++ [2, 3])
+OUTPUT
+tests/lhs-first-line.lhs:1:17-29: Suggestion: Use :
+Found:
+ [1] ++ [2, 3]
+Perhaps:
+ 1 : [2, 3]
+
+1 hint
diff --git a/tests/no_explicit_cpp.test b/tests/no_explicit_cpp.test
new file mode 100644
--- /dev/null
+++ b/tests/no_explicit_cpp.test
@@ -0,0 +1,17 @@
+---------------------------------------------------------------------
+RUN tests/NoExplicitCpp.hs -XHaskell2010
+FILE tests/NoExplicitCpp.hs
+-- We expect C-preprocessing despite `CPP` not being in the
+-- enabled extensions implied by the command line. See issue
+-- https://github.com/ndmitchell/hlint/issues/1360.
+{-# LANGUAGE CPP #-}
+#if 1
+hlint = __HLINT__
+#endif
+OUTPUT
+tests/NoExplicitCpp.hs:4:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
diff --git a/tests/parse-error.test b/tests/parse-error.test
new file mode 100644
--- /dev/null
+++ b/tests/parse-error.test
@@ -0,0 +1,33 @@
+---------------------------------------------------------------------
+RUN "--ignore=Parse error" tests/ignore-parse-error.hs
+FILE tests/ignore-parse-error.hs
+where
+OUTPUT
+No hints
+
+---------------------------------------------------------------------
+RUN tests/ignore-parse-error2.hs
+FILE tests/ignore-parse-error2.hs
+module Foo where
+
+where
+OUTPUT
+tests/ignore-parse-error2.hs:3:1-5: Error: Parse error: on input `where'
+Found:
+ module Foo where
+
+ > where
+
+1 error
+
+---------------------------------------------------------------------
+RUN tests/ignore-parse-error3.hs
+FILE tests/ignore-parse-error3.hs
+{-# LANGUAGE InvalidExtension #-}
+OUTPUT
+tests/ignore-parse-error3.hs:1:1: Error: Parse error: tests/ignore-parse-error3.hs:1:14: error: [GHC-46537]
+ Unsupported extension: InvalidExtension
+Found:
+ {-# LANGUAGE InvalidExtension #-}
+
+1 error
diff --git a/tests/sarif.test b/tests/sarif.test
new file mode 100644
--- /dev/null
+++ b/tests/sarif.test
@@ -0,0 +1,38 @@
+---------------------------------------------------------------------
+RUN tests/sarif-none.hs --sarif
+FILE tests/sarif-none.hs
+foo = (+1)
+OUTPUT
+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[]}]}
+
+---------------------------------------------------------------------
+RUN tests/sarif-one.hs --sarif
+FILE tests/sarif-one.hs
+foo = (+1)
+bar x = foo x
+OUTPUT
+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-one.hs:2:1-13: Warning: Eta reduce\nFound:\n bar x = foo x\nPerhaps:\n bar = foo\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-one.hs"},"region":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14}},"logicalLocations":[{"name":"bar","fullyQualifiedName":"Main.bar"}]}],"fixes":[{"description":{"text":"Eta reduce"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-one.hs"},"replacements":[{"deletedRegion":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14},"insertedContent":{"text":"bar = foo"}}]}]}],"ruleId":"Eta reduce"}]}]}
+
+---------------------------------------------------------------------
+RUN tests/sarif-two.hs --sarif
+FILE tests/sarif-two.hs
+foo = (+1)
+bar x = foo x
+baz = getLine >>= pure . upper
+OUTPUT
+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-two.hs:2:1-13: Warning: Eta reduce\nFound:\n bar x = foo x\nPerhaps:\n bar = foo\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-two.hs"},"region":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14}},"logicalLocations":[{"name":"bar","fullyQualifiedName":"Main.bar"}]}],"fixes":[{"description":{"text":"Eta reduce"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-two.hs"},"replacements":[{"deletedRegion":{"startLine":2,"startColumn":1,"endLine":2,"endColumn":14},"insertedContent":{"text":"bar = foo"}}]}]}],"ruleId":"Eta reduce"},{"message":{"text":"tests/sarif-two.hs:3:7-30: Suggestion: Use <&>\nFound:\n getLine >>= pure . upper\nPerhaps:\n getLine Data.Functor.<&> upper\n"},"level":"note","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-two.hs"},"region":{"startLine":3,"startColumn":7,"endLine":3,"endColumn":31}},"logicalLocations":[{"name":"baz","fullyQualifiedName":"Main.baz"}]}],"fixes":[{"description":{"text":"Use <&>"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-two.hs"},"replacements":[{"deletedRegion":{"startLine":3,"startColumn":7,"endLine":3,"endColumn":31},"insertedContent":{"text":"getLine Data.Functor.<&> upper"}}]}]}],"ruleId":"Use <&>"}]}]}
+
+---------------------------------------------------------------------
+RUN tests/sarif-parse-error.hs --sarif
+FILE tests/sarif-parse-error.hs
+@
+OUTPUT
+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-parse-error.hs:1:1: Error: Parse error: on input `@'\nFound:\n > @\n"},"level":"error","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-parse-error.hs"},"region":{"startLine":1,"startColumn":1,"endLine":1,"endColumn":2}}}],"fixes":[{"description":{"text":"Parse error: on input `@'"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-parse-error.hs"},"replacements":[{"deletedRegion":{"startLine":1,"startColumn":1,"endLine":1,"endColumn":2}}]}]}],"ruleId":"Parse error: on input `@'"}]}]}
+
+---------------------------------------------------------------------
+RUN tests/sarif-note.hs --sarif
+FILE tests/sarif-note.hs
+foo = any (a ==)
+bar = foldl (&&) True
+OUTPUT
+{"version":"2.1.0","$schema":"https://raw.githubusercontent.com/oasis-tcs/sarif-spec/master/Schemata/sarif-schema-2.1.0.json","runs":[{"tool":{"driver":{"name":"hlint","version":"__VERSION__","informationUri":"https://github.com/ndmitchell/hlint"}},"results":[{"message":{"text":"tests/sarif-note.hs:1:7-16: Warning: Use elem\nFound:\n any (a ==)\nPerhaps:\n elem a\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-note.hs"},"region":{"startLine":1,"startColumn":7,"endLine":1,"endColumn":17}},"logicalLocations":[{"name":"foo","fullyQualifiedName":"Main.foo"}]}],"fixes":[{"description":{"text":"Use elem"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-note.hs"},"replacements":[{"deletedRegion":{"startLine":1,"startColumn":7,"endLine":1,"endColumn":17},"insertedContent":{"text":"elem a"}}]}]}],"ruleId":"Use elem"},{"message":{"text":"tests/sarif-note.hs:2:7-21: Warning: Use and\nFound:\n foldl (&&) True\nPerhaps:\n and\nNote: increases laziness\n"},"level":"warning","locations":[{"physicalLocation":{"artifactLocation":{"uri":"tests/sarif-note.hs"},"region":{"startLine":2,"startColumn":7,"endLine":2,"endColumn":22}},"logicalLocations":[{"name":"bar","fullyQualifiedName":"Main.bar"}]}],"fixes":[{"description":{"text":"Use and"},"artifactChanges":[{"artifactLocation":{"uri":"tests/sarif-note.hs"},"replacements":[{"deletedRegion":{"startLine":2,"startColumn":7,"endLine":2,"endColumn":22},"insertedContent":{"text":"and"}}]}]}],"ruleId":"Use and"}]}]}
diff --git a/tests/serialise.test b/tests/serialise.test
new file mode 100644
--- /dev/null
+++ b/tests/serialise.test
@@ -0,0 +1,85 @@
+---------------------------------------------------------------------
+RUN tests/serialise-none.hs --serialise
+FILE tests/serialise-none.hs
+foo = (+1)
+OUTPUT
+[]
+
+---------------------------------------------------------------------
+RUN tests/serialise-one.hs --serialise
+FILE tests/serialise-one.hs
+foo = (+1)
+bar x = foo x
+OUTPUT
+[("tests/serialise-one.hs:2:1-13: Warning: Eta reduce\nFound:\n bar x = foo x\nPerhaps:\n bar = foo\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 2, startCol = 1, endLine = 2, endCol = 14}, subts = [("body",SrcSpan {startLine = 2, startCol = 9, endLine = 2, endCol = 12})], orig = "bar = body"}])]
+
+---------------------------------------------------------------------
+RUN tests/serialise-two.hs --serialise
+FILE tests/serialise-two.hs
+foo = (+1)
+bar x = foo x
+baz = getLine >>= pure . upper
+OUTPUT
+[("tests/serialise-two.hs:2:1-13: Warning: Eta reduce\nFound:\n bar x = foo x\nPerhaps:\n bar = foo\n",[Replace {rtype = Decl, pos = SrcSpan {startLine = 2, startCol = 1, endLine = 2, endCol = 14}, subts = [("body",SrcSpan {startLine = 2, startCol = 9, endLine = 2, endCol = 12})], orig = "bar = body"}]),("tests/serialise-two.hs:3:7-30: Suggestion: Use <&>\nFound:\n getLine >>= pure . upper\nPerhaps:\n getLine Data.Functor.<&> upper\n",[Replace {rtype = Expr, pos = SrcSpan {startLine = 3, startCol = 7, endLine = 3, endCol = 31}, subts = [("f",SrcSpan {startLine = 3, startCol = 26, endLine = 3, endCol = 31}),("m",SrcSpan {startLine = 3, startCol = 7, endLine = 3, endCol = 14})], orig = "m Data.Functor.<&> f"}])]
+
+
+---------------------------------------------------------------------
+RUN tests/serialise-three.hs --serialise
+FILE tests/serialise-three.hs
+foo = concat (map f (let x = x in x))
+OUTPUT
+[("tests/serialise-three.hs:1:7-37: Warning: Use concatMap\nFound:\n concat (map f (let x = x in x))\nPerhaps:\n concatMap f (let x = x in x)\n",[Replace {rtype = Expr, pos = SrcSpan {startLine = 1, startCol = 7, endLine = 1, endCol = 38}, subts = [("f",SrcSpan {startLine = 1, startCol = 19, endLine = 1, endCol = 20}),("x",SrcSpan {startLine = 1, startCol = 21, endLine = 1, endCol = 37})], orig = "concatMap f x"}])]
+
+
+---------------------------------------------------------------------
+RUN tests/serialise-four.hs --serialise --hint=data/hlint.yaml
+FILE tests/serialise-four.hs
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP #-}
+OUTPUT
+[("tests/serialise-four.hs:2:1-20: Warning: Use fewer LANGUAGE pragmas\nFound:\n {-# LANGUAGE CPP #-}\n {-# LANGUAGE CPP #-}\nPerhaps:\n {-# LANGUAGE CPP #-}\n",[ModifyComment {pos = SrcSpan {startLine = 2, startCol = 1, endLine = 2, endCol = 21}, newComment = "{-# LANGUAGE CPP #-}"},ModifyComment {pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 21}, newComment = ""}])]
+
+
+---------------------------------------------------------------------
+RUN tests/serialise-five.hs --serialise
+FILE tests/serialise-five.hs
+import qualified GHC as GHC
+OUTPUT
+[("tests/serialise-five.hs:1:1-27: Suggestion: Redundant as\nFound:\n import qualified GHC as GHC\nPerhaps:\n import qualified GHC\n",[RemoveAsKeyword {pos = SrcSpan {startLine = 1, startCol = 1, endLine = 1, endCol = 28}}])]
+
+
+---------------------------------------------------------------------
+RUN tests/serialise-six.hs --serialise
+FILE tests/serialise-six.hs
+foo = qux (\x -> f (g x))
+OUTPUT
+[("tests/serialise-six.hs:1:12-24: Suggestion: Avoid lambda\nFound:\n / x -> f (g x)\nPerhaps:\n f . g\n",[Replace {rtype = Expr, pos = SrcSpan {startLine = 1, startCol = 12, endLine = 1, endCol = 25}, subts = [("a",SrcSpan {startLine = 1, startCol = 18, endLine = 1, endCol = 19}),("b",SrcSpan {startLine = 1, startCol = 21, endLine = 1, endCol = 22})], orig = "a . b"}])]
+
+
+---------------------------------------------------------------------
+RUN tests/serialise-seven.hs --serialise
+FILE tests/serialise-seven.hs
+foo = if baz
+ then qux
+ else if baz'
+ then qux'
+ else qux''
+OUTPUT
+[("tests/serialise-seven.hs:(1,1)-(5,23): Suggestion: Use guards\nFound:\n foo = if baz then qux else if baz' then qux' else qux''\nPerhaps:\n foo\n | baz = qux\n | baz' = qux'\n | otherwise = qux''\n",[Replace {rtype = Match, pos = SrcSpan {startLine = 1, startCol = 1, endLine = 5, endCol = 24}, subts = [("g1001",SrcSpan {startLine = 1, startCol = 10, endLine = 1, endCol = 13}),("g1002",SrcSpan {startLine = 3, startCol = 17, endLine = 3, endCol = 21}),("e1001",SrcSpan {startLine = 2, startCol = 14, endLine = 2, endCol = 17}),("e1002",SrcSpan {startLine = 4, startCol = 19, endLine = 4, endCol = 23}),("e1003",SrcSpan {startLine = 5, startCol = 19, endLine = 5, endCol = 24})], orig = "foo\n | g1001 = e1001\n | g1002 = e1002\n | otherwise = e1003"}])]
+
+
+---------------------------------------------------------------------
+RUN tests/serialise-eight.hs --serialise
+FILE tests/serialise-eight.hs
+foo = do x <- baz
+ x
+OUTPUT
+[("tests/serialise-eight.hs:(1,7)-(2,10): Warning: Use join\nFound:\n do x <- baz\n x\nPerhaps:\n do join baz\n",[Replace {rtype = Stmt, pos = SrcSpan {startLine = 1, startCol = 10, endLine = 1, endCol = 18}, subts = [("x",SrcSpan {startLine = 1, startCol = 15, endLine = 1, endCol = 18})], orig = "join x"},Delete {rtype = Stmt, pos = SrcSpan {startLine = 2, startCol = 10, endLine = 2, endCol = 11}}])]
+
+
+---------------------------------------------------------------------
+RUN tests/serialise-nine.hs --serialise
+FILE tests/serialise-nine.hs
+foo | True = baz
+OUTPUT
+[("tests/serialise-nine.hs:1:1-16: Suggestion: Redundant guard\nFound:\n foo | True = baz\nPerhaps:\n foo = baz\n",[Delete {rtype = Stmt, pos = SrcSpan {startLine = 1, startCol = 7, endLine = 1, endCol = 11}}])]
diff --git a/tests/wildcards.test b/tests/wildcards.test
new file mode 100644
--- /dev/null
+++ b/tests/wildcards.test
@@ -0,0 +1,816 @@
+----
+RUN tests/wildcards-a.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-a.hs
+import A as Z
+OUTPUT
+tests/wildcards-a.hs:1:1-13: Warning: Avoid restricted alias
+Found:
+ import A as Z
+Perhaps:
+ import A as A
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-xa.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xa.hs
+import XA as Z
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-a.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-a.hs
+import X.A as Z
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-y-a.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-a.hs
+import X.Y.A as Z
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-b.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-b.hs
+import B as Z
+OUTPUT
+tests/wildcards-b.hs:1:1-13: Warning: Avoid restricted alias
+Found:
+ import B as Z
+Perhaps:
+ import B as B
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-xb.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xb.hs
+import XB as Z
+OUTPUT
+tests/wildcards-xb.hs:1:1-14: Warning: Avoid restricted alias
+Found:
+ import XB as Z
+Perhaps:
+ import XB as B
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-b.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-b.hs
+import X.B as Z
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-y-b.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-b.hs
+import X.Y.B as Z
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-c.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-c.hs
+import C as Z
+OUTPUT
+tests/wildcards-c.hs:1:1-13: Warning: Avoid restricted alias
+Found:
+ import C as Z
+Perhaps:
+ import C as C
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-xc.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xc.hs
+import XC as Z
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-c.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-c.hs
+import X.C as Z
+OUTPUT
+tests/wildcards-x-c.hs:1:1-15: Warning: Avoid restricted alias
+Found:
+ import X.C as Z
+Perhaps:
+ import X.C as C
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-y-c.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-c.hs
+import X.Y.C as Z
+OUTPUT
+tests/wildcards-x-y-c.hs:1:1-17: Warning: Avoid restricted alias
+Found:
+ import X.Y.C as Z
+Perhaps:
+ import X.Y.C as C
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-d.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-d.hs
+import D as Z
+OUTPUT
+tests/wildcards-d.hs:1:1-13: Warning: Avoid restricted alias
+Found:
+ import D as Z
+Perhaps:
+ import D as D
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-xd.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xd.hs
+import XD as Z
+OUTPUT
+tests/wildcards-xd.hs:1:1-14: Warning: Avoid restricted alias
+Found:
+ import XD as Z
+Perhaps:
+ import XD as D
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-d.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-d.hs
+import X.D as Z
+OUTPUT
+tests/wildcards-x-d.hs:1:1-15: Warning: Avoid restricted alias
+Found:
+ import X.D as Z
+Perhaps:
+ import X.D as D
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-y-d.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-d.hs
+import X.Y.D as Z
+OUTPUT
+tests/wildcards-x-y-d.hs:1:1-17: Warning: Avoid restricted alias
+Found:
+ import X.Y.D as Z
+Perhaps:
+ import X.Y.D as D
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-e.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-e.hs
+module E where import E
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-xe.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xe.hs
+module XE where import E
+OUTPUT
+tests/wildcards-xe.hs:1:17-24: Warning: Avoid restricted module
+Found:
+ import E
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-e.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-e.hs
+module X.E where import E
+OUTPUT
+tests/wildcards-x-e.hs:1:18-25: Warning: Avoid restricted module
+Found:
+ import E
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-y-e.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-e.hs
+module X.Y.E where import E
+OUTPUT
+tests/wildcards-x-y-e.hs:1:20-27: Warning: Avoid restricted module
+Found:
+ import E
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-f.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-f.hs
+module F where import F
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-xf.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xf.hs
+module XF where import F
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-f.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-f.hs
+module X.F where import F
+OUTPUT
+tests/wildcards-x-f.hs:1:18-25: Warning: Avoid restricted module
+Found:
+ import F
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-y-f.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-f.hs
+module X.Y.F where import F
+OUTPUT
+tests/wildcards-x-y-f.hs:1:20-27: Warning: Avoid restricted module
+Found:
+ import F
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-g.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-g.hs
+module G where import G
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-xg.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xg.hs
+module XG where import G
+OUTPUT
+tests/wildcards-xg.hs:1:17-24: Warning: Avoid restricted module
+Found:
+ import G
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcards-x-g.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-g.hs
+module X.G where import G
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-y-g.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-g.hs
+module X.Y.G where import G
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-h.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-h.hs
+module H where import H
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-xh.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-xh.hs
+module XH where import H
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-h.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-h.hs
+module X.H where import H
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-x-y-h.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-x-y-h.hs
+module X.Y.H where import H
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-u.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-u.hs
+module U where import U
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-module-xu.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-module-xu.hs
+module XU where import U
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-module-x-u.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-module-x-u.hs
+module X.U where import U
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-module-x-y-u.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-module-x-y-u.hs
+module X.Y.U where import U
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-import-xu.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-import-xu.hs
+module U where import XU
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-import-x-u.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-import-x-u.hs
+module U where import X.U
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-import-x-y-u.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-import-x-y-u.hs
+module U where import X.Y.U
+OUTPUT
+No hints
+
+----
+RUN tests/wildcards-module-w.hs --hint=data/wildcards.yaml
+FILE tests/wildcards-module-w.hs
+module W where import U
+OUTPUT
+tests/wildcards-module-w.hs:1:16-23: Warning: Avoid restricted module
+Found:
+ import U
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-i.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-i.hs
+module I where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xi.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xi.hs
+module XI where x = y (\ _ -> z)
+OUTPUT
+tests/wildcard-xi.hs:1:24-31: Suggestion: Use const
+Found:
+ \ _ -> z
+Perhaps:
+ const z
+
+1 hint
+
+----
+RUN tests/wildcard-x-i.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-i.hs
+module X.I where x = y (\ _ -> z)
+OUTPUT
+tests/wildcard-x-i.hs:1:25-32: Suggestion: Use const
+Found:
+ \ _ -> z
+Perhaps:
+ const z
+
+1 hint
+
+----
+RUN tests/wildcard-x-y-i.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-i.hs
+module X.Y.I where x = y (\ _ -> z)
+OUTPUT
+tests/wildcard-x-y-i.hs:1:27-34: Suggestion: Use const
+Found:
+ \ _ -> z
+Perhaps:
+ const z
+
+1 hint
+
+----
+RUN tests/wildcard-j.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-j.hs
+module J where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xj.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xj.hs
+module XJ where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-j.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-j.hs
+module X.J where x = y (\ _ -> z)
+OUTPUT
+tests/wildcard-x-j.hs:1:25-32: Suggestion: Use const
+Found:
+ \ _ -> z
+Perhaps:
+ const z
+
+1 hint
+
+----
+RUN tests/wildcard-x-y-j.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-j.hs
+module X.Y.J where x = y (\ _ -> z)
+OUTPUT
+tests/wildcard-x-y-j.hs:1:27-34: Suggestion: Use const
+Found:
+ \ _ -> z
+Perhaps:
+ const z
+
+1 hint
+
+----
+RUN tests/wildcard-k.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-k.hs
+module K where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xk.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xk.hs
+module XK where x = y (\ _ -> z)
+OUTPUT
+tests/wildcard-xk.hs:1:24-31: Suggestion: Use const
+Found:
+ \ _ -> z
+Perhaps:
+ const z
+
+1 hint
+
+----
+RUN tests/wildcard-x-k.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-k.hs
+module X.K where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-y-k.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-k.hs
+module X.Y.K where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-l.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-l.hs
+module L where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xl.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xl.hs
+module XL where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-l.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-l.hs
+module X.L where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-y-l.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-l.hs
+module X.Y.L where x = y (\ _ -> z)
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-m.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-m.hs
+{-# LANGUAGE CPP #-} module M where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xm.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xm.hs
+{-# LANGUAGE CPP #-} module XM where
+OUTPUT
+tests/wildcard-xm.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-m.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-m.hs
+{-# LANGUAGE CPP #-} module X.M where
+OUTPUT
+tests/wildcard-x-m.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-y-m.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-m.hs
+{-# LANGUAGE CPP #-} module X.Y.M where
+OUTPUT
+tests/wildcard-x-y-m.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-n.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-n.hs
+{-# LANGUAGE CPP #-} module N where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xn.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xn.hs
+{-# LANGUAGE CPP #-} module XN where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-n.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-n.hs
+{-# LANGUAGE CPP #-} module X.N where
+OUTPUT
+tests/wildcard-x-n.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-y-n.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-n.hs
+{-# LANGUAGE CPP #-} module X.Y.N where
+OUTPUT
+tests/wildcard-x-y-n.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-o.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-o.hs
+{-# LANGUAGE CPP #-} module O where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xo.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xo.hs
+{-# LANGUAGE CPP #-} module XO where
+OUTPUT
+tests/wildcard-xo.hs:1:1-20: Warning: Avoid restricted extensions
+Found:
+ {-# LANGUAGE CPP #-}
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-o.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-o.hs
+{-# LANGUAGE CPP #-} module X.O where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-y-o.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-o.hs
+{-# LANGUAGE CPP #-} module X.Y.O where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-p.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-p.hs
+{-# LANGUAGE CPP #-} module P where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xp.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xp.hs
+{-# LANGUAGE CPP #-} module XP where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-p.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-p.hs
+{-# LANGUAGE CPP #-} module X.P where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-y-p.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-p.hs
+{-# LANGUAGE CPP #-} module X.Y.P where
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-q.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-q.hs
+module Q where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xq.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xq.hs
+module XQ where x = read ""
+OUTPUT
+tests/wildcard-xq.hs:1:21-24: Warning: Avoid restricted function
+Found:
+ read
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-q.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-q.hs
+module X.Q where x = read ""
+OUTPUT
+tests/wildcard-x-q.hs:1:22-25: Warning: Avoid restricted function
+Found:
+ read
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-y-q.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-q.hs
+module X.Y.Q where x = read ""
+OUTPUT
+tests/wildcard-x-y-q.hs:1:24-27: Warning: Avoid restricted function
+Found:
+ read
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-r.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-r.hs
+module R where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xr.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xr.hs
+module XR where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-r.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-r.hs
+module X.R where x = read ""
+OUTPUT
+tests/wildcard-x-r.hs:1:22-25: Warning: Avoid restricted function
+Found:
+ read
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-y-r.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-r.hs
+module X.Y.R where x = read ""
+OUTPUT
+tests/wildcard-x-y-r.hs:1:24-27: Warning: Avoid restricted function
+Found:
+ read
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-s.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-s.hs
+module S where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xs.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xs.hs
+module XS where x = read ""
+OUTPUT
+tests/wildcard-xs.hs:1:21-24: Warning: Avoid restricted function
+Found:
+ read
+Note: may break the code
+
+1 hint
+
+----
+RUN tests/wildcard-x-s.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-s.hs
+module X.S where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-y-s.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-s.hs
+module X.Y.S where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-t.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-t.hs
+module T where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-xt.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-xt.hs
+module XT where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-t.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-t.hs
+module X.T where x = read ""
+OUTPUT
+No hints
+
+----
+RUN tests/wildcard-x-y-t.hs --hint=data/wildcards.yaml
+FILE tests/wildcard-x-y-t.hs
+module X.Y.T where x = read ""
+OUTPUT
+No hints