{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
module HLint(hlint, readAllSettings) where
import Control.Applicative
import Control.Monad.Extra
import Control.Exception.Extra
import Control.Concurrent.Extra
import System.Console.CmdArgs.Verbosity
import GHC.Util.DynFlags
import Data.List.Extra
import GHC.Conc
import System.Directory
import System.Exit
import System.IO.Extra
import System.Time.Extra
import Data.Tuple.Extra
import Data.Bifunctor (bimap)
import Prelude
import CmdLine
import Config.Read
import Config.Type
import Config.Compute
import Report
import Summary
import Idea
import Apply
import Test.All
import Hint.All
import Refact
import Timing
import Parallel
import GHC.All
import CC
import EmbedData
import SARIF qualified
hlint :: [String] -> IO [Idea]
hlint :: [String] -> IO [Idea]
hlint [String]
args = do
IO ()
startTimings
cmd <- [String] -> IO Cmd
getCmd [String]
args
timedIO "Initialise" "global flags" initGlobalDynFlags
if cmdTest cmd then
hlintTest cmd >> pure []
else do
(time, xs) <- duration $ hlintMain args cmd
when (cmdTiming cmd) $ do
printTimings
putStrLn $ "Took " ++ showDuration time
pure $ if cmdNoExitCode cmd then [] else xs
hlintTest :: Cmd -> IO ()
hlintTest :: Cmd -> IO ()
hlintTest cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
..} = do
failed <- Cmd -> ([String] -> IO ()) -> String -> [String] -> IO Int
test Cmd
cmd (\[String]
args -> do errs <- [String] -> IO [Idea]
hlint [String]
args; unless (null errs) $ exitWith $ ExitFailure 1) String
cmdDataDir [String]
cmdGivenHints
when (failed > 0) exitFailure
cmdParseFlags :: Cmd -> ParseFlags
cmdParseFlags :: Cmd -> ParseFlags
cmdParseFlags Cmd
cmd = (Maybe Language, ([Extension], [Extension]))
-> ParseFlags -> ParseFlags
parseFlagsSetLanguage (Cmd -> (Maybe Language, ([Extension], [Extension]))
cmdExtensions Cmd
cmd) (ParseFlags -> ParseFlags) -> ParseFlags -> ParseFlags
forall a b. (a -> b) -> a -> b
$ ParseFlags
defaultParseFlags{cppFlags=cmdCpp cmd}
withVerbosity :: Verbosity -> IO a -> IO a
withVerbosity :: forall a. Verbosity -> IO a -> IO a
withVerbosity Verbosity
new IO a
act = do
old <- IO Verbosity
getVerbosity
(setVerbosity new >> act) `finally` setVerbosity old
hlintMain :: [String] -> Cmd -> IO [Idea]
hlintMain :: [String] -> Cmd -> IO [Idea]
hlintMain [String]
args cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
..}
| Bool
cmdDefault = do
ideas <- if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFiles then [Idea] -> IO [Idea]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [] else Verbosity -> IO [Idea] -> IO [Idea]
forall a. Verbosity -> IO a -> IO a
withVerbosity Verbosity
Quiet (IO [Idea] -> IO [Idea]) -> IO [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$
[String] -> Cmd -> Maybe String -> IO [Idea]
runHlintMain [String]
args Cmd
cmd{cmdJson=False,cmdSerialise=False,cmdRefactor=False} Maybe String
forall a. Maybe a
Nothing
let bad = [String] -> [[String]]
forall a. Eq a => [a] -> [[a]]
group ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ [String] -> [String]
forall a. Ord a => [a] -> [a]
sort ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Idea -> String) -> [Idea] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Idea -> String
ideaHint [Idea]
ideas
if null bad then putStr defaultYaml else do
let group1:groups = splitOn ["",""] $ lines defaultYaml
let group2 = String
"# Warnings currently triggered by your code" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
[String
"- ignore: {name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"} # "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
tl then String
"1 hint" else Int -> String
forall a. Show a => a -> String
show ([String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" hints"
| xs :: [String]
xs@(String
x : [String]
tl) <- [[String]]
bad
]
putStr $ unlines $ intercalate ["",""] $ group1:group2:groups
pure []
| [String]
cmdGenerateMdSummary [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = do
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
cmdGenerateMdSummary ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
file -> String -> String -> IO () -> IO ()
forall a. String -> String -> IO a -> IO a
timedIO String
"Summary" String
file (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenNormal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing Markdown summary to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ..."
summary <- [Setting] -> IO String
generateMdSummary ([Setting] -> IO String)
-> ((Cmd, [Setting]) -> [Setting]) -> (Cmd, [Setting]) -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cmd, [Setting]) -> [Setting]
forall a b. (a, b) -> b
snd ((Cmd, [Setting]) -> IO String) -> IO (Cmd, [Setting]) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [String]
args Cmd
cmd
writeFileBinary file summary
[Idea] -> IO [Idea]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| [String]
cmdGenerateJsonSummary [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = do
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
cmdGenerateJsonSummary ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
file -> String -> String -> IO () -> IO ()
forall a. String -> String -> IO a -> IO a
timedIO String
"Summary" String
file (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenNormal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing JSON summary to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ..."
summary <- [Setting] -> IO String
generateJsonSummary ([Setting] -> IO String)
-> ((Cmd, [Setting]) -> [Setting]) -> (Cmd, [Setting]) -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cmd, [Setting]) -> [Setting]
forall a b. (a, b) -> b
snd ((Cmd, [Setting]) -> IO String) -> IO (Cmd, [Setting]) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [String]
args Cmd
cmd
writeFileBinary file summary
[Idea] -> IO [Idea]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| [Severity]
cmdGenerateExhaustiveConf [Severity] -> [Severity] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] = do
[Severity] -> (Severity -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Severity]
cmdGenerateExhaustiveConf ((Severity -> IO ()) -> IO ()) -> (Severity -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Severity
severity ->
let file :: String
file = Severity -> String
forall a. Show a => a -> String
show Severity
severity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-all.yaml"
in String -> String -> IO () -> IO ()
forall a. String -> String -> IO a -> IO a
timedIO String
"Exhaustive config file" String
file (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO () -> IO ()
whenNormal (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Severity -> String
forall a. Show a => a -> String
show Severity
severity String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-all list to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ..."
exhaustiveConfig <- Severity -> [Setting] -> IO String
generateExhaustiveConfig Severity
severity ([Setting] -> IO String)
-> ((Cmd, [Setting]) -> [Setting]) -> (Cmd, [Setting]) -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Cmd, [Setting]) -> [Setting]
forall a b. (a, b) -> b
snd ((Cmd, [Setting]) -> IO String) -> IO (Cmd, [Setting]) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [String]
args Cmd
cmd
writeFileBinary file exhaustiveConfig
[Idea] -> IO [Idea]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
| [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFiles Bool -> Bool -> Bool
&& Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFindHints) = do
hints <- (String -> IO [String]) -> [String] -> IO [String]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (Cmd -> Maybe String -> String -> IO [String]
resolveFile Cmd
cmd Maybe String
forall a. Maybe a
Nothing) [String]
cmdFindHints
mapM_ (putStrLn . fst <=< computeSettings (cmdParseFlags cmd)) hints >> pure []
| [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFiles =
IO [Idea]
forall a. IO a
exitWithHelp
| Bool
cmdRefactor =
(String -> IO [Idea]) -> IO [Idea]
forall a. (String -> IO a) -> IO a
withTempFile ((String -> IO [Idea]) -> IO [Idea])
-> (String -> IO [Idea]) -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ [String] -> Cmd -> Maybe String -> IO [Idea]
runHlintMain [String]
args Cmd
cmd (Maybe String -> IO [Idea])
-> (String -> Maybe String) -> String -> IO [Idea]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just
| Bool
otherwise =
[String] -> Cmd -> Maybe String -> IO [Idea]
runHlintMain [String]
args Cmd
cmd Maybe String
forall a. Maybe a
Nothing
runHlintMain :: [String] -> Cmd -> Maybe FilePath -> IO [Idea]
runHlintMain :: [String] -> Cmd -> Maybe String -> IO [Idea]
runHlintMain [String]
args Cmd
cmd Maybe String
tmpFile = do
(cmd, settings) <- [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [String]
args Cmd
cmd
runHints args settings =<< resolveFiles cmd tmpFile
resolveFiles :: Cmd -> Maybe FilePath -> IO Cmd
resolveFiles :: Cmd -> Maybe String -> IO Cmd
resolveFiles cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
..} Maybe String
tmpFile = do
cmdFiles <- if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String
"lint"] [String] -> [String] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [String]
cmdFiles then [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String]
cmdFiles else do
b <- String -> IO Bool
doesDirectoryExist String
"lint"
pure $ if b then cmdFiles else drop1 cmdFiles
files <- concatMapM (resolveFile cmd tmpFile) cmdFiles
if null files
then error "No files found"
else pure cmd { cmdFiles = files }
readAllSettings :: [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings :: [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [String]
args1 cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
..} = do
files <- Cmd -> IO [(String, Maybe String)]
cmdHintFiles Cmd
cmd
settings1 <-
readFilesConfig $
files
++ [("CommandLine.yaml",Just (enableGroup x)) | x <- cmdWithGroups]
let args2 = [String
x | SettingArgument String
x <- [Setting]
settings1]
cmd@CmdMain{..} <- if null args2 then pure cmd else getCmd $ args2 ++ args1
settings2 <- concatMapM (fmap snd . computeSettings (cmdParseFlags cmd)) cmdFindHints
let settings3 = [Classify -> Setting
SettingClassify (Classify -> Setting) -> Classify -> Setting
forall a b. (a -> b) -> a -> b
$ Severity -> String -> String -> String -> Classify
Classify Severity
Ignore String
x String
"" String
"" | String
x <- [String]
cmdIgnore]
cmdThreads <- if cmdThreads == 0 then getNumProcessors else pure cmdThreads
cmd <- pure CmdMain {..}
pure (cmd, settings1 ++ settings2 ++ settings3)
where
enableGroup :: String -> String
enableGroup String
groupName =
[String] -> String
unlines
[String
"- group:"
,String
" name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
groupName
,String
" enabled: true"
]
runHints :: [String] -> [Setting] -> Cmd -> IO [Idea]
runHints :: [String] -> [Setting] -> Cmd -> IO [Idea]
runHints [String]
args [Setting]
settings cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
..} =
Int -> IO [Idea] -> IO [Idea]
forall a. Int -> IO a -> IO a
withNumCapabilities Int
cmdThreads (IO [Idea] -> IO [Idea]) -> IO [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ do
let outStrLn :: String -> IO ()
outStrLn = IO () -> IO ()
whenNormal (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
ideas <- [Idea] -> [Idea]
filterIdeas ([Idea] -> [Idea]) -> IO [Idea] -> IO [Idea]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Cmd -> [Setting] -> IO [Idea]
getIdeas Cmd
cmd [Setting]
settings
if cmdJson then
putStrLn $ showIdeasJson ideas
else if cmdCC then
mapM_ (printIssue . fromIdea) ideas
else if cmdSARIF then
SARIF.printIdeas ideas
else if cmdSerialise then do
hSetBuffering stdout NoBuffering
print $ map (show &&& ideaRefactoring) ideas
else if cmdRefactor then
handleRefactoring ideas cmdFiles cmd
else do
usecolour <- cmdUseColour cmd
let showItem = if Bool
usecolour then Idea -> String
showIdeaANSI else Idea -> String
forall a. Show a => a -> String
show
mapM_ (outStrLn . showItem) ideas
handleReporting ideas cmd
pure ideas
where
filteredSeverities :: [Severity]
filteredSeverities
| Bool
cmdShowAll = []
| Bool
cmdIgnoreSuggestions = [Severity
Ignore, Severity
Suggestion]
| Bool
otherwise = [Severity
Ignore]
filterIdeas :: [Idea] -> [Idea]
filterIdeas = (Idea -> Bool) -> [Idea] -> [Idea]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Idea
i -> Idea -> Severity
ideaSeverity Idea
i Severity -> [Severity] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Severity]
filteredSeverities)
getIdeas :: Cmd -> [Setting] -> IO [Idea]
getIdeas :: Cmd -> [Setting] -> IO [Idea]
getIdeas cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
..} [Setting]
settings = do
settings <- [Setting] -> IO [Setting]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Setting] -> IO [Setting]) -> [Setting] -> IO [Setting]
forall a b. (a -> b) -> a -> b
$ [Setting]
settings [Setting] -> [Setting] -> [Setting]
forall a. [a] -> [a] -> [a]
++ ((String, Hint) -> Setting) -> [(String, Hint)] -> [Setting]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Setting
Builtin (String -> Setting)
-> ((String, Hint) -> String) -> (String, Hint) -> Setting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Hint) -> String
forall a b. (a, b) -> a
fst) [(String, Hint)]
builtinHints
let flags = Cmd -> ParseFlags
cmdParseFlags Cmd
cmd
ideas <- if cmdCross
then applyHintFiles flags settings cmdFiles
else concat <$> parallel cmdThreads [evaluateList =<< applyHintFile flags settings x Nothing | x <- cmdFiles]
pure $ if not (null cmdOnly)
then [i | i <- ideas, ideaHint i `elem` cmdOnly]
else ideas
handleRefactoring :: [Idea] -> [String] -> Cmd -> IO ()
handleRefactoring :: [Idea] -> [String] -> Cmd -> IO ()
handleRefactoring [Idea]
ideas [String]
files cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
..} =
case [String]
cmdFiles of
[String
file] -> do
path <- Maybe String -> IO String
checkRefactor (if String
cmdWithRefactor String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
cmdWithRefactor)
let hints = [(String, [Refactoring SrcSpan])] -> String
forall a. Show a => a -> String
show ([(String, [Refactoring SrcSpan])] -> String)
-> [(String, [Refactoring SrcSpan])] -> String
forall a b. (a -> b) -> a -> b
$ (Idea -> (String, [Refactoring SrcSpan]))
-> [Idea] -> [(String, [Refactoring SrcSpan])]
forall a b. (a -> b) -> [a] -> [b]
map (Idea -> String
forall a. Show a => a -> String
show (Idea -> String)
-> (Idea -> [Refactoring SrcSpan])
-> Idea
-> (String, [Refactoring SrcSpan])
forall a b c. (a -> b) -> (a -> c) -> a -> (b, c)
&&& Idea -> [Refactoring SrcSpan]
ideaRefactoring) [Idea]
ideas
withTempFile $ \String
f -> do
String -> String -> IO ()
writeFile String
f String
hints
let ParseFlags{[Extension]
enabledExtensions :: [Extension]
enabledExtensions :: ParseFlags -> [Extension]
enabledExtensions, [Extension]
disabledExtensions :: [Extension]
disabledExtensions :: ParseFlags -> [Extension]
disabledExtensions} = Cmd -> ParseFlags
cmdParseFlags Cmd
cmd
ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> IO ExitCode -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String
-> String
-> String
-> [Extension]
-> [Extension]
-> String
-> IO ExitCode
runRefactoring String
path String
file String
f [Extension]
enabledExtensions [Extension]
disabledExtensions String
cmdRefactorOptions
[String]
_ -> String -> IO ()
forall a. HasCallStack => String -> IO a
errorIO String
"Refactor flag can only be used with an individual file"
handleReporting :: [Idea] -> Cmd -> IO ()
handleReporting :: [Idea] -> Cmd -> IO ()
handleReporting [Idea]
showideas cmd :: Cmd
cmd@CmdMain{Bool
Int
String
[String]
[Severity]
ColorMode
cmdTest :: Cmd -> Bool
cmdTiming :: Cmd -> Bool
cmdNoExitCode :: Cmd -> Bool
cmdGenerateExhaustiveConf :: Cmd -> [Severity]
cmdGenerateJsonSummary :: Cmd -> [String]
cmdGenerateMdSummary :: Cmd -> [String]
cmdIgnoreGlob :: Cmd -> [String]
cmdWithRefactor :: Cmd -> String
cmdRefactorOptions :: Cmd -> String
cmdRefactor :: Cmd -> Bool
cmdSerialise :: Cmd -> Bool
cmdOnly :: Cmd -> [String]
cmdNoSummary :: Cmd -> Bool
cmdSARIF :: Cmd -> Bool
cmdCC :: Cmd -> Bool
cmdJson :: Cmd -> Bool
cmdCppAnsi :: Cmd -> Bool
cmdCppSimple :: Cmd -> Bool
cmdCppFile :: Cmd -> [String]
cmdCppInclude :: Cmd -> [String]
cmdCppDefine :: Cmd -> [String]
cmdPath :: Cmd -> [String]
cmdDefault :: Cmd -> Bool
cmdDataDir :: Cmd -> String
cmdFindHints :: Cmd -> [String]
cmdCross :: Cmd -> Bool
cmdLanguage :: Cmd -> [String]
cmdExtension :: Cmd -> [String]
cmdIgnoreSuggestions :: Cmd -> Bool
cmdShowAll :: Cmd -> Bool
cmdIgnore :: Cmd -> [String]
cmdThreads :: Cmd -> Int
cmdColor :: Cmd -> ColorMode
cmdGit :: Cmd -> Bool
cmdWithGroups :: Cmd -> [String]
cmdGivenHints :: Cmd -> [String]
cmdReports :: Cmd -> [String]
cmdFiles :: Cmd -> [String]
cmdFiles :: [String]
cmdReports :: [String]
cmdGivenHints :: [String]
cmdWithGroups :: [String]
cmdGit :: Bool
cmdColor :: ColorMode
cmdThreads :: Int
cmdIgnore :: [String]
cmdShowAll :: Bool
cmdIgnoreSuggestions :: Bool
cmdExtension :: [String]
cmdLanguage :: [String]
cmdCross :: Bool
cmdFindHints :: [String]
cmdDataDir :: String
cmdDefault :: Bool
cmdPath :: [String]
cmdCppDefine :: [String]
cmdCppInclude :: [String]
cmdCppFile :: [String]
cmdCppSimple :: Bool
cmdCppAnsi :: Bool
cmdJson :: Bool
cmdCC :: Bool
cmdSARIF :: Bool
cmdNoSummary :: Bool
cmdOnly :: [String]
cmdNoExitCode :: Bool
cmdTiming :: Bool
cmdSerialise :: Bool
cmdRefactor :: Bool
cmdRefactorOptions :: String
cmdWithRefactor :: String
cmdIgnoreGlob :: [String]
cmdGenerateMdSummary :: [String]
cmdGenerateJsonSummary :: [String]
cmdGenerateExhaustiveConf :: [Severity]
cmdTest :: Bool
..} = do
let outStrLn :: String -> IO ()
outStrLn = IO () -> IO ()
whenNormal (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
cmdReports ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
x -> do
String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Writing report to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" ..."
String -> String -> [Idea] -> IO ()
writeReport String
cmdDataDir String
x [Idea]
showideas
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cmdNoSummary (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let (Int
nbErrors, Int
nbHints) = ([Idea] -> Int)
-> ([Idea] -> Int) -> ([Idea], [Idea]) -> (Int, Int)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Idea] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Idea] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([Idea], [Idea]) -> (Int, Int)) -> ([Idea], [Idea]) -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ (Idea -> Bool) -> [Idea] -> ([Idea], [Idea])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\Idea
idea -> Idea -> Severity
ideaSeverity Idea
idea Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
== Severity
Error) [Idea]
showideas
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
nbErrors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
formatOutput Int
nbErrors String
"error")
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int
nbErrors Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
nbHints Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
formatOutput Int
nbHints String
"hint")
where
formatOutput :: Int -> String -> String
formatOutput :: Int -> String -> String
formatOutput Int
number String
name =
if Int
number Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then String
"No " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"s" else Int -> String
forall a. Show a => a -> String
show Int
number String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ [Char
's' | Int
numberInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=Int
1]
evaluateList :: [a] -> IO [a]
evaluateList :: forall a. [a] -> IO [a]
evaluateList [a]
xs = do
Int -> IO Int
forall a. a -> IO a
evaluate (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$ [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
[a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [a]
xs