{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}
module HLint(hlint, readAllSettings) where
import Control.Applicative
import Control.Monad.Extra
import Control.Exception
import Control.Concurrent.Extra
import System.Console.CmdArgs.Verbosity
import Data.List.Extra
import GHC.Conc
import System.Exit
import System.IO.Extra
import System.Time.Extra
import Data.Tuple.Extra
import Prelude
import Data.Version.Extra
import System.Process.Extra
import Data.Maybe
import System.Directory
import CmdLine
import Config.Read
import Config.Type
import Config.Compute
import Report
import Idea
import Apply
import Test.All
import Hint.All
import Grep
import Timing
import Test.Proof
import Parallel
import HSE.All
import CC
import EmbedData
hlint :: [String] -> IO [Idea]
hlint :: [String] -> IO [Idea]
hlint args :: [String]
args = do
Cmd
cmd <- [String] -> IO Cmd
getCmd [String]
args
case Cmd
cmd of
CmdMain{} -> do
IO ()
startTimings
(time :: Seconds
time, xs :: [Idea]
xs) <- IO [Idea] -> IO (Seconds, [Idea])
forall a. IO a -> IO (Seconds, a)
duration (IO [Idea] -> IO (Seconds, [Idea]))
-> IO [Idea] -> IO (Seconds, [Idea])
forall a b. (a -> b) -> a -> b
$ [String] -> Cmd -> IO [Idea]
hlintMain [String]
args Cmd
cmd
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Cmd -> Bool
cmdTiming Cmd
cmd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IO ()
printTimings
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Took " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Seconds -> String
showDuration Seconds
time
[Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Idea] -> IO [Idea]) -> [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ if Cmd -> Bool
cmdNoExitCode Cmd
cmd then [] else [Idea]
xs
CmdGrep{} -> Cmd -> IO ()
hlintGrep Cmd
cmd IO () -> IO [Idea] -> IO [Idea]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return []
CmdHSE{} -> Cmd -> IO ()
hlintHSE Cmd
cmd IO () -> IO [Idea] -> IO [Idea]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return []
CmdTest{} -> Cmd -> IO ()
hlintTest Cmd
cmd IO () -> IO [Idea] -> IO [Idea]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return []
hlintHSE :: Cmd -> IO ()
hlintHSE :: Cmd -> IO ()
hlintHSE c :: Cmd
c@CmdHSE{..} = do
Verbosity
v <- IO Verbosity
getVerbosity
[String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
cmdFiles ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \x :: String
x -> do
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Parse result of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ ":"
let (lang :: Language
lang,exts :: [Extension]
exts) = Cmd -> (Language, [Extension])
cmdExtensions Cmd
c
ParseResult (Module SrcSpanInfo)
res <- ParseMode -> String -> IO (ParseResult (Module SrcSpanInfo))
parseFileWithMode ParseMode
defaultParseMode{baseLanguage :: Language
baseLanguage=Language
lang, extensions :: [Extension]
extensions=[Extension]
exts} String
x
case ParseResult (Module SrcSpanInfo)
res of
x :: ParseResult (Module SrcSpanInfo)
x@ParseFailed{} -> ParseResult (Module SrcSpanInfo) -> IO ()
forall a. Show a => a -> IO ()
print ParseResult (Module SrcSpanInfo)
x
ParseOk m :: Module SrcSpanInfo
m -> case Verbosity
v of
Loud -> Module SrcSpanInfo -> IO ()
forall a. Show a => a -> IO ()
print Module SrcSpanInfo
m
Quiet -> String -> IO ()
forall a. Show a => a -> IO ()
print (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Module SrcSpanInfo -> String
forall a. Pretty a => a -> String
prettyPrint Module SrcSpanInfo
m
_ -> Module () -> IO ()
forall a. Show a => a -> IO ()
print (Module () -> IO ()) -> Module () -> IO ()
forall a b. (a -> b) -> a -> b
$ Module SrcSpanInfo -> Module ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Module SrcSpanInfo
m
String -> IO ()
putStrLn ""
hlintTest :: Cmd -> IO ()
hlintTest :: Cmd -> IO ()
hlintTest cmd :: Cmd
cmd@CmdTest{..} =
if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdProof then do
[(String, Maybe String)]
files <- Cmd -> IO [(String, Maybe String)]
cmdHintFiles Cmd
cmd
[Setting]
s <- [(String, Maybe String)] -> IO [Setting]
readFilesConfig [(String, Maybe String)]
files
let reps :: [String]
reps = if [String]
cmdReports [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
== ["report.html"] then ["report.txt"] else [String]
cmdReports
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([String] -> [Setting] -> String -> IO ()
proof [String]
reps [Setting]
s) [String]
cmdProof
else do
Int
failed <- Cmd -> ([String] -> IO ()) -> String -> [String] -> IO Int
test Cmd
cmd (\args :: [String]
args -> do [Idea]
errs <- [String] -> IO [Idea]
hlint [String]
args; Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Idea] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Idea]
errs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith (ExitCode -> IO ()) -> ExitCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> ExitCode
ExitFailure 1) String
cmdDataDir [String]
cmdGivenHints
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
failed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0) IO ()
forall a. IO a
exitFailure
cmdParseFlags :: Cmd -> ParseFlags
cmdParseFlags :: Cmd -> ParseFlags
cmdParseFlags cmd :: Cmd
cmd = (Language, [Extension]) -> ParseFlags -> ParseFlags
parseFlagsSetLanguage (Cmd -> (Language, [Extension])
cmdExtensions Cmd
cmd) (ParseFlags -> ParseFlags) -> ParseFlags -> ParseFlags
forall a b. (a -> b) -> a -> b
$ ParseFlags
defaultParseFlags{cppFlags :: CppFlags
cppFlags=Cmd -> CppFlags
cmdCpp Cmd
cmd}
hlintGrep :: Cmd -> IO ()
hlintGrep :: Cmd -> IO ()
hlintGrep cmd :: Cmd
cmd@CmdGrep{..} =
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFiles then
IO ()
forall a. IO a
exitWithHelp
else do
[String]
files <- (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]
cmdFiles
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files then
String -> IO ()
forall a. HasCallStack => String -> a
error "No files found"
else
String -> ParseFlags -> [String] -> IO ()
runGrep String
cmdPattern (Cmd -> ParseFlags
cmdParseFlags Cmd
cmd) [String]
files
withVerbosity :: Verbosity -> IO a -> IO a
withVerbosity :: Verbosity -> IO a -> IO a
withVerbosity new :: Verbosity
new act :: IO a
act = do
Verbosity
old <- IO Verbosity
getVerbosity
(Verbosity -> IO ()
setVerbosity Verbosity
new IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
act) IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`finally` Verbosity -> IO ()
setVerbosity Verbosity
old
hlintMain :: [String] -> Cmd -> IO [Idea]
hlintMain :: [String] -> Cmd -> IO [Idea]
hlintMain args :: [String]
args cmd :: Cmd
cmd@CmdMain{..}
| Bool
cmdDefault = do
[Idea]
ideas <- if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFiles then [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return [] 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 :: Bool
cmdJson=Bool
False,cmdSerialise :: Bool
cmdSerialise=Bool
False,cmdRefactor :: Bool
cmdRefactor=Bool
False} Maybe String
forall a. Maybe a
Nothing
let bad :: [String]
bad = [String] -> [String]
forall a. Ord a => [a] -> [a]
nubOrd ([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 [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
bad then String -> IO ()
putStr String
defaultYaml else do
let group1 :: [String]
group1:groups :: [[String]]
groups = [String] -> [String] -> [[String]]
forall a. (HasCallStack, Eq a) => [a] -> [a] -> [[a]]
splitOn ["",""] ([String] -> [[String]]) -> [String] -> [[String]]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
defaultYaml
let group2 :: [String]
group2 = "# Warnings currently triggered by your code" String -> [String] -> [String]
forall a. a -> [a] -> [a]
:
["- 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
x <- [String]
bad]
String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate ["",""] ([[String]] -> [String]) -> [[String]] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
group1[String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
:[String]
group2[String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
:[[String]]
groups
[Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFiles Bool -> Bool -> Bool
&& Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdFindHints) = do
[String]
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
(String -> IO ()) -> [String] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
putStrLn (String -> IO ())
-> ((String, [Setting]) -> String) -> (String, [Setting]) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [Setting]) -> String
forall a b. (a, b) -> a
fst ((String, [Setting]) -> IO ())
-> (String -> IO (String, [Setting])) -> String -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ParseFlags -> String -> IO (String, [Setting])
computeSettings (Cmd -> ParseFlags
cmdParseFlags Cmd
cmd)) [String]
hints IO () -> IO [Idea] -> IO [Idea]
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return []
| [String] -> 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 args :: [String]
args cmd :: Cmd
cmd tmpFile :: Maybe String
tmpFile = do
(cmd :: Cmd
cmd, settings :: [Setting]
settings) <- [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings [String]
args Cmd
cmd
[String] -> [Setting] -> Cmd -> IO [Idea]
runHints [String]
args [Setting]
settings (Cmd -> IO [Idea]) -> IO Cmd -> IO [Idea]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd -> Maybe String -> IO Cmd
resolveFiles Cmd
cmd Maybe String
tmpFile
resolveFiles :: Cmd -> Maybe FilePath -> IO Cmd
resolveFiles :: Cmd -> Maybe String -> IO Cmd
resolveFiles cmd :: Cmd
cmd@CmdMain{..} tmpFile :: Maybe String
tmpFile = do
[String]
files <- (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
tmpFile) [String]
cmdFiles
if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
files
then String -> IO Cmd
forall a. HasCallStack => String -> a
error "No files found"
else Cmd -> IO Cmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd { cmdFiles :: [String]
cmdFiles = [String]
files }
resolveFiles cmd :: Cmd
cmd _ = Cmd -> IO Cmd
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd
readAllSettings :: [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings :: [String] -> Cmd -> IO (Cmd, [Setting])
readAllSettings args1 :: [String]
args1 cmd :: Cmd
cmd@CmdMain{..} = do
[(String, Maybe String)]
files <- Cmd -> IO [(String, Maybe String)]
cmdHintFiles Cmd
cmd
[Setting]
settings1 <-
[(String, Maybe String)] -> IO [Setting]
readFilesConfig ([(String, Maybe String)] -> IO [Setting])
-> [(String, Maybe String)] -> IO [Setting]
forall a b. (a -> b) -> a -> b
$
[(String, Maybe String)]
files
[(String, Maybe String)]
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. [a] -> [a] -> [a]
++ [("CommandLine.hs",String -> Maybe String
forall a. a -> Maybe a
Just String
x) | String
x <- [String]
cmdWithHints]
[(String, Maybe String)]
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. [a] -> [a] -> [a]
++ [("CommandLine.yaml",String -> Maybe String
forall a. a -> Maybe a
Just (String -> String
enableGroup String
x)) | String
x <- [String]
cmdWithGroups]
let args2 :: [String]
args2 = [String
x | SettingArgument x :: String
x <- [Setting]
settings1]
cmd :: Cmd
cmd@CmdMain{..} <- if [String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args2 then Cmd -> IO Cmd
forall (m :: * -> *) a. Monad m => a -> m a
return Cmd
cmd else [String] -> IO Cmd
getCmd ([String] -> IO Cmd) -> [String] -> IO Cmd
forall a b. (a -> b) -> a -> b
$ [String]
args2 [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args1
[Setting]
settings2 <- (String -> IO [Setting]) -> [String] -> IO [Setting]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (((String, [Setting]) -> [Setting])
-> IO (String, [Setting]) -> IO [Setting]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, [Setting]) -> [Setting]
forall a b. (a, b) -> b
snd (IO (String, [Setting]) -> IO [Setting])
-> (String -> IO (String, [Setting])) -> String -> IO [Setting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseFlags -> String -> IO (String, [Setting])
computeSettings (Cmd -> ParseFlags
cmdParseFlags Cmd
cmd)) [String]
cmdFindHints
[Setting]
settings3 <- [Setting] -> IO [Setting]
forall (m :: * -> *) a. Monad m => a -> m a
return [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
x <- [String]
cmdIgnore]
(Cmd, [Setting]) -> IO (Cmd, [Setting])
forall (m :: * -> *) a. Monad m => a -> m a
return (Cmd
cmd, [Setting]
settings1 [Setting] -> [Setting] -> [Setting]
forall a. [a] -> [a] -> [a]
++ [Setting]
settings2 [Setting] -> [Setting] -> [Setting]
forall a. [a] -> [a] -> [a]
++ [Setting]
settings3)
where
enableGroup :: String -> String
enableGroup groupName :: String
groupName =
[String] -> String
unlines
["- group:"
," name: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
groupName
," enabled: true"
]
runHints :: [String] -> [Setting] -> Cmd -> IO [Idea]
runHints :: [String] -> [Setting] -> Cmd -> IO [Idea]
runHints args :: [String]
args settings :: [Setting]
settings cmd :: Cmd
cmd@CmdMain{..} = do
Int
j <- if Int
cmdThreads Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then IO Int
getNumProcessors else Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
cmdThreads
Int -> IO [Idea] -> IO [Idea]
forall a. Int -> IO a -> IO a
withNumCapabilities Int
j (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
[Idea]
ideas <- Cmd -> [Setting] -> IO [Idea]
getIdeas Cmd
cmd [Setting]
settings
[Idea]
ideas <- [Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Idea] -> IO [Idea]) -> [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ if Bool
cmdShowAll then [Idea]
ideas else (Idea -> Bool) -> [Idea] -> [Idea]
forall a. (a -> Bool) -> [a] -> [a]
filter (\i :: Idea
i -> Idea -> Severity
ideaSeverity Idea
i Severity -> Severity -> Bool
forall a. Eq a => a -> a -> Bool
/= Severity
Ignore) [Idea]
ideas
if Bool
cmdJson then
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [Idea] -> String
showIdeasJson [Idea]
ideas
else if Bool
cmdCC then
(Idea -> IO ()) -> [Idea] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Issue -> IO ()
printIssue (Issue -> IO ()) -> (Idea -> Issue) -> Idea -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Issue
fromIdea) [Idea]
ideas
else if Bool
cmdSerialise then do
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
NoBuffering
[(String, [Refactoring SrcSpan])] -> IO ()
forall a. Show a => a -> IO ()
print ([(String, [Refactoring SrcSpan])] -> IO ())
-> [(String, [Refactoring SrcSpan])] -> IO ()
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
else if Bool
cmdRefactor then
[Idea] -> [String] -> Cmd -> IO ()
handleRefactoring [Idea]
ideas [String]
cmdFiles Cmd
cmd
else do
Bool
usecolour <- Cmd -> IO Bool
cmdUseColour Cmd
cmd
Idea -> String
showItem <- if Bool
usecolour then IO (Idea -> String)
showANSI else (Idea -> String) -> IO (Idea -> String)
forall (m :: * -> *) a. Monad m => a -> m a
return Idea -> String
forall a. Show a => a -> String
show
(Idea -> IO ()) -> [Idea] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String -> IO ()
outStrLn (String -> IO ()) -> (Idea -> String) -> Idea -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> String
showItem) [Idea]
ideas
[Idea] -> Cmd -> IO ()
handleReporting [Idea]
ideas Cmd
cmd
[Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return [Idea]
ideas
getIdeas :: Cmd -> [Setting] -> IO [Idea]
getIdeas :: Cmd -> [Setting] -> IO [Idea]
getIdeas cmd :: Cmd
cmd@CmdMain{..} settings :: [Setting]
settings = do
[Setting]
settings <- [Setting] -> IO [Setting]
forall (m :: * -> *) a. Monad m => a -> m a
return ([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 :: ParseFlags
flags = Cmd -> ParseFlags
cmdParseFlags Cmd
cmd
[Idea]
ideas <- if Bool
cmdCross
then ParseFlags -> [Setting] -> [String] -> IO [Idea]
applyHintFiles ParseFlags
flags [Setting]
settings [String]
cmdFiles
else [[Idea]] -> [Idea]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Idea]] -> [Idea]) -> IO [[Idea]] -> IO [Idea]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [IO [Idea]] -> IO [[Idea]]
forall a. Int -> [IO a] -> IO [a]
parallel Int
cmdThreads [[Idea] -> IO [Idea]
forall a. [a] -> IO [a]
evaluateList ([Idea] -> IO [Idea]) -> IO [Idea] -> IO [Idea]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParseFlags -> [Setting] -> String -> Maybe String -> IO [Idea]
applyHintFile ParseFlags
flags [Setting]
settings String
x Maybe String
forall a. Maybe a
Nothing | String
x <- [String]
cmdFiles]
[Idea] -> IO [Idea]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Idea] -> IO [Idea]) -> [Idea] -> IO [Idea]
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not ([String] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdOnly)
then [Idea
i | Idea
i <- [Idea]
ideas, Idea -> String
ideaHint Idea
i String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
cmdOnly]
else [Idea]
ideas
handleRefactoring :: [Idea] -> [String] -> Cmd -> IO ()
handleRefactoring :: [Idea] -> [String] -> Cmd -> IO ()
handleRefactoring [] _ _ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
handleRefactoring ideas :: [Idea]
ideas files :: [String]
files cmd :: Cmd
cmd@CmdMain{..} =
case [String]
cmdFiles of
[file :: String
file] -> do
String
path <- Maybe String -> IO String
checkRefactor (if String
cmdWithRefactor String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "" then Maybe String
forall a. Maybe a
Nothing else String -> Maybe String
forall a. a -> Maybe a
Just String
cmdWithRefactor)
let hints :: String
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
(String -> IO ()) -> IO ()
forall a. (String -> IO a) -> IO a
withTempFile ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \f :: String
f -> do
String -> String -> IO ()
writeFile String
f String
hints
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 -> String -> IO ExitCode
runRefactoring String
path String
file String
f String
cmdRefactorOptions
_ -> String -> IO ()
forall a. HasCallStack => String -> a
error "Refactor flag can only be used with an individual file"
handleReporting :: [Idea] -> Cmd -> IO ()
handleReporting :: [Idea] -> Cmd -> IO ()
handleReporting showideas :: [Idea]
showideas cmd :: Cmd
cmd@CmdMain{..} = 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
$ \x :: String
x -> do
String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ "Writing report to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ " ..."
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 n :: Int
n = [Idea] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Idea]
showideas
String -> IO ()
outStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "No hints" else Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " hint" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ['s' | Int
nInt -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/=1]
runRefactoring :: FilePath -> FilePath -> FilePath -> String -> IO ExitCode
runRefactoring :: String -> String -> String -> String -> IO ExitCode
runRefactoring rpath :: String
rpath fin :: String
fin hints :: String
hints opts :: String
opts = do
let args :: [String]
args = [String
fin, "-v0"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ String -> [String]
words String
opts [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ["--refact-file", String
hints]
(_, _, _, phand :: ProcessHandle
phand) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess (CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle))
-> CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
forall a b. (a -> b) -> a -> b
$ String -> [String] -> CreateProcess
proc String
rpath [String]
args
IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
LineBuffering :: IO (Either IOException ())
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
phand
checkRefactor :: Maybe FilePath -> IO FilePath
checkRefactor :: Maybe String -> IO String
checkRefactor rpath :: Maybe String
rpath = do
let excPath :: String
excPath = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe "refactor" Maybe String
rpath
Maybe String
mexc <- String -> IO (Maybe String)
findExecutable String
excPath
case Maybe String
mexc of
Just exc :: String
exc -> do
Version
ver <- HasCallStack => String -> Version
String -> Version
readVersion (String -> Version) -> (String -> String) -> String -> Version
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
tail (String -> Version) -> IO String -> IO Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
exc ["--version"] ""
if Version -> [Int]
versionBranch Version
ver [Int] -> [Int] -> Bool
forall a. Ord a => a -> a -> Bool
>= [0,1,0,0]
then String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
exc
else String -> IO String
forall a. HasCallStack => String -> a
error "Your version of refactor is too old, please upgrade to the latest version"
Nothing -> String -> IO String
forall a. HasCallStack => String -> a
error (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [ "Could not find refactor", "Tried with: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
excPath ]
evaluateList :: [a] -> IO [a]
evaluateList :: [a] -> IO [a]
evaluateList xs :: [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 (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
[a] -> IO [a]
forall (m :: * -> *) a. Monad m => a -> m a
return [a]
xs