{-# LANGUAGE ImportQualifiedPost, CPP #-}
{-# LANGUAGE PatternGuards, DeriveDataTypeable, TupleSections #-}
{-# OPTIONS_GHC -Wno-missing-fields -fno-cse -O0 #-}

module CmdLine(
    Cmd(..), getCmd,
    CppFlags(..), cmdCpp, cmdExtensions, cmdHintFiles, cmdUseColour,
    exitWithHelp, resolveFile
    ) where

import Control.Monad.Extra
import Control.Exception.Extra
import Data.ByteString qualified as BS
import Data.Char
import Data.List.NonEmpty qualified as NE
import Data.List.Extra
import Data.Maybe
import Data.Functor
import GHC.All(CppFlags(..))
import GHC.LanguageExtensions.Type
import Language.Haskell.GhclibParserEx.GHC.Driver.Session as GhclibParserEx
import GHC.Driver.Session hiding (verbosity)

import Language.Preprocessor.Cpphs
import System.Console.ANSI(hSupportsANSI)
import System.Console.CmdArgs.Explicit(helpText, HelpFormat(..))
import System.Console.CmdArgs.Implicit
import System.Directory.Extra
import System.Environment
import System.Exit
import System.FilePath
import System.IO
import System.IO.Error
import System.Process
import System.FilePattern

import EmbedData
import Util
import Timing
import Extension
import Paths_hlint
import Data.Version
import Prelude
import Config.Type (Severity (Warning))


getCmd :: [String] -> IO Cmd
getCmd :: [String] -> IO Cmd
getCmd [String]
args = [String] -> IO Cmd -> IO Cmd
forall a. [String] -> IO a -> IO a
withArgs ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
f [String]
args) (IO Cmd -> IO Cmd) -> IO Cmd -> IO Cmd
forall a b. (a -> b) -> a -> b
$ Cmd -> IO Cmd
automatic (Cmd -> IO Cmd) -> IO Cmd -> IO Cmd
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Mode (CmdArgs Cmd) -> IO Cmd
forall a. Mode (CmdArgs a) -> IO a
cmdArgsRun Mode (CmdArgs Cmd)
mode
    where f :: String -> String
f String
x = if String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"-?" Bool -> Bool -> Bool
|| String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--help" then String
"--help=all" else String
x


automatic :: Cmd -> IO Cmd
automatic :: Cmd -> IO Cmd
automatic Cmd
cmd = Cmd -> IO Cmd
dataDir (Cmd -> IO Cmd) -> IO Cmd -> IO Cmd
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd -> IO Cmd
forall {f :: * -> *}. Applicative f => Cmd -> f Cmd
path (Cmd -> IO Cmd) -> IO Cmd -> IO Cmd
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd -> IO Cmd
git (Cmd -> IO Cmd) -> IO Cmd -> IO Cmd
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd -> IO Cmd
forall {f :: * -> *}. Applicative f => Cmd -> f Cmd
extension Cmd
cmd
    where
        path :: Cmd -> f Cmd
path Cmd
cmd = Cmd -> f Cmd
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cmd -> f Cmd) -> Cmd -> f Cmd
forall a b. (a -> b) -> a -> b
$ if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Cmd -> [String]
cmdPath Cmd
cmd then Cmd
cmd{cmdPath=["."]} else Cmd
cmd
        extension :: Cmd -> f Cmd
extension Cmd
cmd = Cmd -> f Cmd
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Cmd -> f Cmd) -> Cmd -> f Cmd
forall a b. (a -> b) -> a -> b
$ if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ Cmd -> [String]
cmdExtension Cmd
cmd then Cmd
cmd{cmdExtension=["hs","lhs"]} else Cmd
cmd
        dataDir :: Cmd -> IO Cmd
dataDir Cmd
cmd
            | Cmd -> String
cmdDataDir Cmd
cmd  String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"" = Cmd -> IO Cmd
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd
            | Bool
otherwise = do
                String
x <- IO String
getDataDir
                Bool
b <- String -> IO Bool
doesDirectoryExist String
x
                if Bool
b then Cmd -> IO Cmd
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd{cmdDataDir=x} else do
                    String
exe <- IO String
getExecutablePath
                    Cmd -> IO Cmd
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd{cmdDataDir = takeDirectory exe </> "data"}
        git :: Cmd -> IO Cmd
git Cmd
cmd
            | Cmd -> Bool
cmdGit Cmd
cmd = do
                Maybe String
mgit <- String -> IO (Maybe String)
findExecutable String
"git"
                case Maybe String
mgit of
                    Maybe String
Nothing -> String -> IO Cmd
forall a. HasCallStack => String -> IO a
errorIO String
"Could not find git"
                    Just String
git -> do
                        let args :: [String]
args = [String
"ls-files", String
"--cached", String
"--others", String
"--exclude-standard"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
                                   (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"*." String -> String -> String
forall a. [a] -> [a] -> [a]
++) (Cmd -> [String]
cmdExtension Cmd
cmd)
                        String
files <- String -> String -> IO String -> IO String
forall a. String -> String -> IO a -> IO a
timedIO String
"Execute" ([String] -> String
unwords ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ String
gitString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
args) (IO String -> IO String) -> IO String -> IO String
forall a b. (a -> b) -> a -> b
$
                            String -> [String] -> String -> IO String
readProcess String
git [String]
args String
""
                        Cmd -> IO Cmd
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd{cmdFiles = cmdFiles cmd ++ lines files}
            | Bool
otherwise = Cmd -> IO Cmd
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd


exitWithHelp :: IO a
exitWithHelp :: forall a. IO a
exitWithHelp = do
    String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> String
forall a. Show a => a -> String
show ([Text] -> String) -> [Text] -> String
forall a b. (a -> b) -> a -> b
$ [String] -> HelpFormat -> Mode (CmdArgs Cmd) -> [Text]
forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText [] HelpFormat
HelpFormatAll Mode (CmdArgs Cmd)
mode
    IO a
forall a. IO a
exitSuccess


-- | When to colour terminal output.
data ColorMode
    = Never  -- ^ Terminal output will never be coloured.
    | Always -- ^ Terminal output will always be coloured.
    | Auto   -- ^ Terminal output will be coloured if $TERM and stdout appear to support it, and NO_COLOR is not set.
      deriving (Int -> ColorMode -> String -> String
[ColorMode] -> String -> String
ColorMode -> String
(Int -> ColorMode -> String -> String)
-> (ColorMode -> String)
-> ([ColorMode] -> String -> String)
-> Show ColorMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ColorMode -> String -> String
showsPrec :: Int -> ColorMode -> String -> String
$cshow :: ColorMode -> String
show :: ColorMode -> String
$cshowList :: [ColorMode] -> String -> String
showList :: [ColorMode] -> String -> String
Show, Typeable, Typeable ColorMode
Typeable ColorMode =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ColorMode -> c ColorMode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ColorMode)
-> (ColorMode -> Constr)
-> (ColorMode -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ColorMode))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColorMode))
-> ((forall b. Data b => b -> b) -> ColorMode -> ColorMode)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ColorMode -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ColorMode -> r)
-> (forall u. (forall d. Data d => d -> u) -> ColorMode -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ColorMode -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ColorMode -> m ColorMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColorMode -> m ColorMode)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ColorMode -> m ColorMode)
-> Data ColorMode
ColorMode -> Constr
ColorMode -> DataType
(forall b. Data b => b -> b) -> ColorMode -> ColorMode
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ColorMode -> u
forall u. (forall d. Data d => d -> u) -> ColorMode -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMode -> c ColorMode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColorMode)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMode -> c ColorMode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMode -> c ColorMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMode
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMode
$ctoConstr :: ColorMode -> Constr
toConstr :: ColorMode -> Constr
$cdataTypeOf :: ColorMode -> DataType
dataTypeOf :: ColorMode -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColorMode)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColorMode)
$cgmapT :: (forall b. Data b => b -> b) -> ColorMode -> ColorMode
gmapT :: (forall b. Data b => b -> b) -> ColorMode -> ColorMode
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColorMode -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColorMode -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColorMode -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColorMode -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
Data)


instance Default ColorMode where
  def :: ColorMode
def = ColorMode
Auto


data Cmd
    = CmdMain
        {Cmd -> [String]
cmdFiles :: [FilePath]    -- ^ which files to run it on, nothing = none given
        ,Cmd -> [String]
cmdReports :: [FilePath]        -- ^ where to generate reports
        ,Cmd -> [String]
cmdGivenHints :: [FilePath]     -- ^ which settings files were explicitly given
        ,Cmd -> [String]
cmdWithGroups :: [String]       -- ^ groups that are given on the command line
        ,Cmd -> Bool
cmdGit :: Bool                  -- ^ use git ls-files to find files
        ,Cmd -> ColorMode
cmdColor :: ColorMode           -- ^ color the result
        ,Cmd -> Int
cmdThreads :: Int              -- ^ Number of threads to use, 0 = whatever GHC has
        ,Cmd -> [String]
cmdIgnore :: [String]           -- ^ the hints to ignore
        ,Cmd -> Bool
cmdShowAll :: Bool              -- ^ display all skipped items
        ,Cmd -> Bool
cmdIgnoreSuggestions :: Bool    -- ^ ignore suggestions
        ,Cmd -> [String]
cmdExtension :: [String]        -- ^ extensions
        ,Cmd -> [String]
cmdLanguage :: [String]      -- ^ the extensions (may be prefixed by "No")
        ,Cmd -> Bool
cmdCross :: Bool                -- ^ work between source files, applies to hints such as duplicate code between modules
        ,Cmd -> [String]
cmdFindHints :: [FilePath]      -- ^ source files to look for hints in
        ,Cmd -> String
cmdDataDir :: FilePath          -- ^ the data directory
        ,Cmd -> Bool
cmdDefault :: Bool              -- ^ Print a default file to stdout
        ,Cmd -> [String]
cmdPath :: [String]
        ,Cmd -> [String]
cmdCppDefine :: [String]
        ,Cmd -> [String]
cmdCppInclude :: [FilePath]
        ,Cmd -> [String]
cmdCppFile :: [FilePath]
        ,Cmd -> Bool
cmdCppSimple :: Bool
        ,Cmd -> Bool
cmdCppAnsi :: Bool
        ,Cmd -> Bool
cmdJson :: Bool                -- ^ display hint data as JSON
        ,Cmd -> Bool
cmdCC :: Bool                  -- ^ display hint data as Code Climate Issues
        ,Cmd -> Bool
cmdSARIF :: Bool               -- ^ display hint data as SARIF
        ,Cmd -> Bool
cmdNoSummary :: Bool           -- ^ do not show the summary info
        ,Cmd -> [String]
cmdOnly :: [String]            -- ^ specify which hints explicitly
        ,Cmd -> Bool
cmdNoExitCode :: Bool
        ,Cmd -> Bool
cmdTiming :: Bool
        ,Cmd -> Bool
cmdSerialise :: Bool           -- ^ Display hints in serialisation format
        ,Cmd -> Bool
cmdRefactor :: Bool            -- ^ Run the `refactor` executable to automatically perform hints
        ,Cmd -> String
cmdRefactorOptions :: String   -- ^ Options to pass to the `refactor` executable.
        ,Cmd -> String
cmdWithRefactor :: FilePath    -- ^ Path to refactor tool
        ,Cmd -> [String]
cmdIgnoreGlob :: [FilePattern]
        ,Cmd -> [String]
cmdGenerateMdSummary :: [FilePath]  -- ^ Generate a summary of available hints, in Markdown format
        ,Cmd -> [String]
cmdGenerateJsonSummary :: [FilePath]  -- ^ Generate a summary of built-in hints, in JSON format
        ,Cmd -> [Severity]
cmdGenerateExhaustiveConf :: [Severity]  -- ^ Generate a hlint config file with all built-in hints set to the specified level
        ,Cmd -> Bool
cmdTest :: Bool
        }
    deriving (Typeable Cmd
Typeable Cmd =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Cmd -> c Cmd)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Cmd)
-> (Cmd -> Constr)
-> (Cmd -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Cmd))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cmd))
-> ((forall b. Data b => b -> b) -> Cmd -> Cmd)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r)
-> (forall u. (forall d. Data d => d -> u) -> Cmd -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Cmd -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Cmd -> m Cmd)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cmd -> m Cmd)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Cmd -> m Cmd)
-> Data Cmd
Cmd -> Constr
Cmd -> DataType
(forall b. Data b => b -> b) -> Cmd -> Cmd
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Cmd -> u
forall u. (forall d. Data d => d -> u) -> Cmd -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cmd
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cmd -> c Cmd
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cmd)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cmd)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cmd -> c Cmd
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cmd -> c Cmd
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cmd
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cmd
$ctoConstr :: Cmd -> Constr
toConstr :: Cmd -> Constr
$cdataTypeOf :: Cmd -> DataType
dataTypeOf :: Cmd -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cmd)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cmd)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cmd)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cmd)
$cgmapT :: (forall b. Data b => b -> b) -> Cmd -> Cmd
gmapT :: (forall b. Data b => b -> b) -> Cmd -> Cmd
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Cmd -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Cmd -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cmd -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cmd -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
Data,Typeable,Int -> Cmd -> String -> String
[Cmd] -> String -> String
Cmd -> String
(Int -> Cmd -> String -> String)
-> (Cmd -> String) -> ([Cmd] -> String -> String) -> Show Cmd
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Cmd -> String -> String
showsPrec :: Int -> Cmd -> String -> String
$cshow :: Cmd -> String
show :: Cmd -> String
$cshowList :: [Cmd] -> String -> String
showList :: [Cmd] -> String -> String
Show)

mode :: Mode (CmdArgs Cmd)
mode = Cmd -> Mode (CmdArgs Cmd)
forall a. Data a => a -> Mode (CmdArgs a)
cmdArgsMode (Cmd -> Mode (CmdArgs Cmd)) -> Cmd -> Mode (CmdArgs Cmd)
forall a b. (a -> b) -> a -> b
$ [Cmd] -> Cmd
forall val. Data val => [val] -> val
modes
    [CmdMain
        {cmdFiles :: [String]
cmdFiles = [String]
forall a. Default a => a
def [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= Ann
args [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"FILE/DIR"
        ,cmdReports :: [String]
cmdReports = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam String
"report" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
forall a. (Show a, Typeable a) => a -> Ann
opt String
"report.html" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= Ann
typFile [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Generate a report in HTML"
        ,cmdGivenHints :: [String]
cmdGivenHints = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam String
"hint" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= Ann
typFile [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Hint/ignore file to use"
        ,cmdWithGroups :: [String]
cmdWithGroups = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"with-group" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"GROUP" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Extra hint groups to use"
        ,cmdGit :: Bool
cmdGit = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam String
"git" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Run on files tracked by git"
        ,cmdColor :: ColorMode
cmdColor = String -> ColorMode
forall {val}. (Data val, Default val) => String -> val
nam String
"colour" ColorMode -> Ann -> ColorMode
forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"color" ColorMode -> Ann -> ColorMode
forall val. Data val => val -> Ann -> val
&= ColorMode -> Ann
forall a. (Show a, Typeable a) => a -> Ann
opt ColorMode
Always ColorMode -> Ann -> ColorMode
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"always/never/auto" ColorMode -> Ann -> ColorMode
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Color output (requires an ANSI terminal; 'auto' means on if the standard output channel can support ANSI; by itself, selects 'always')"
        ,cmdThreads :: Int
cmdThreads = Int
1 Int -> Ann -> Int
forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"threads" Int -> Ann -> Int
forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"j" Int -> Ann -> Int
forall val. Data val => val -> Ann -> val
&= Int -> Ann
forall a. (Show a, Typeable a) => a -> Ann
opt (Int
0 :: Int) Int -> Ann -> Int
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Number of threads to use (-j for all)"
        ,cmdIgnore :: [String]
cmdIgnore = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam String
"ignore" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"HINT" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Ignore a particular hint"
        ,cmdShowAll :: Bool
cmdShowAll = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam String
"show" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Show all ignored ideas"
        ,cmdIgnoreSuggestions :: Bool
cmdIgnoreSuggestions = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"ignore-suggestions" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Ignore suggestions, only show warnings and errors"
        ,cmdExtension :: [String]
cmdExtension = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam String
"extension" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"EXT" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"File extensions to search (default hs/lhs)"
        ,cmdLanguage :: [String]
cmdLanguage = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"language" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"X" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"EXTENSION" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Language extensions (Arrows, NoCPP)"
        ,cmdCross :: Bool
cmdCross = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"cross" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Work between modules"
        ,cmdFindHints :: [String]
cmdFindHints = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam String
"find" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= Ann
typFile [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Find hints in a Haskell file"
        ,cmdDataDir :: String
cmdDataDir = String -> String
forall {val}. (Data val, Default val) => String -> val
nam_ String
"datadir" String -> Ann -> String
forall val. Data val => val -> Ann -> val
&= Ann
typDir String -> Ann -> String
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Override the data directory"
        ,cmdDefault :: Bool
cmdDefault = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam String
"default" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Print a default file to stdout"
        ,cmdPath :: [String]
cmdPath = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam String
"path" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Directory in which to search for files"
        ,cmdCppDefine :: [String]
cmdCppDefine = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-define" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"NAME[=VALUE]" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"CPP #define"
        ,cmdCppInclude :: [String]
cmdCppInclude = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-include" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= Ann
typDir [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"CPP include path"
        ,cmdCppFile :: [String]
cmdCppFile = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-file" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= Ann
typFile [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"CPP pre-include file"
        ,cmdCppSimple :: Bool
cmdCppSimple = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-simple" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Use a simple CPP (strip # lines)"
        ,cmdCppAnsi :: Bool
cmdCppAnsi = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-ansi" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Use CPP in ANSI compatibility mode"
        ,cmdJson :: Bool
cmdJson = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"json" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display hint data as JSON"
        ,cmdCC :: Bool
cmdCC = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"cc" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display hint data as Code Climate Issues"
        ,cmdSARIF :: Bool
cmdSARIF = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"sarif" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display hint data as SARIF"
        ,cmdNoSummary :: Bool
cmdNoSummary = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"no-summary" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Do not show summary information"
        ,cmdOnly :: [String]
cmdOnly = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam String
"only" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"HINT" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Specify which hints explicitly"
        ,cmdNoExitCode :: Bool
cmdNoExitCode = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"no-exit-code" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Do not give a negative exit if hints"
        ,cmdTiming :: Bool
cmdTiming = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"timing" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display timing information"
        ,cmdSerialise :: Bool
cmdSerialise = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"serialise" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Serialise hint data for consumption by apply-refact"
        ,cmdRefactor :: Bool
cmdRefactor = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"refactor" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Automatically invoke `refactor` to apply hints"
        ,cmdRefactorOptions :: String
cmdRefactorOptions = String -> String
forall {val}. (Data val, Default val) => String -> val
nam_ String
"refactor-options" String -> Ann -> String
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"OPTIONS" String -> Ann -> String
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Options to pass to the `refactor` executable"
        ,cmdWithRefactor :: String
cmdWithRefactor = String -> String
forall {val}. (Data val, Default val) => String -> val
nam_ String
"with-refactor" String -> Ann -> String
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Give the path to refactor"
        ,cmdIgnoreGlob :: [String]
cmdIgnoreGlob = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"ignore-glob" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Ignore paths matching glob pattern (e.g. foo/bar/*.hs)"
        ,cmdGenerateMdSummary :: [String]
cmdGenerateMdSummary = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"generate-summary" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
forall a. (Show a, Typeable a) => a -> Ann
opt String
"hints.md" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Generate a summary of available hints, in Markdown format"
        ,cmdGenerateJsonSummary :: [String]
cmdGenerateJsonSummary = String -> [String]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"generate-summary-json" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
forall a. (Show a, Typeable a) => a -> Ann
opt String
"hints.json" [String] -> Ann -> [String]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Generate a summary of available hints, in JSON format"
        ,cmdGenerateExhaustiveConf :: [Severity]
cmdGenerateExhaustiveConf = String -> [Severity]
forall {val}. (Data val, Default val) => String -> val
nam_ String
"generate-config" [Severity] -> Ann -> [Severity]
forall val. Data val => val -> Ann -> val
&= Severity -> Ann
forall a. (Show a, Typeable a) => a -> Ann
opt Severity
Warning [Severity] -> Ann -> [Severity]
forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"LEVEL" [Severity] -> Ann -> [Severity]
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Generate a .hlint.yaml config file with all hints set to the specified severity level (default level: warn, alternatives: ignore, suggest, error)"
        ,cmdTest :: Bool
cmdTest = String -> Bool
forall {val}. (Data val, Default val) => String -> val
nam_ String
"test" Bool -> Ann -> Bool
forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Run the test suite"
        } Cmd -> Ann -> Cmd
forall val. Data val => val -> Ann -> val
&= Ann
auto Cmd -> Ann -> Cmd
forall val. Data val => val -> Ann -> val
&= Ann
explicit Cmd -> Ann -> Cmd
forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"lint"
        Cmd -> Ann -> Cmd
forall val. Data val => val -> Ann -> val
&= [String] -> Ann
details [String
"HLint gives hints on how to improve Haskell code."
                   ,String
""
                   ,String
"To check all Haskell files in 'src' and generate a report type:"
                   ,String
"  hlint src --report"]
    ] Cmd -> Ann -> Cmd
forall val. Data val => val -> Ann -> val
&= String -> Ann
program String
"hlint" Cmd -> Ann -> Cmd
forall val. Data val => val -> Ann -> val
&= Ann
verbosity
    Cmd -> Ann -> Cmd
forall val. Data val => val -> Ann -> val
&=  String -> Ann
summary (String
"HLint v" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", (C) Neil Mitchell 2006-2024")
    where
        nam :: String -> val
nam String
xs = String -> val
forall {val}. (Data val, Default val) => String -> val
nam_ String
xs val -> Ann -> val
forall val. Data val => val -> Ann -> val
&= String -> Ann
name [NonEmpty Char -> Char
forall a. NonEmpty a -> a
NE.head (NonEmpty Char -> Char) -> NonEmpty Char -> Char
forall a b. (a -> b) -> a -> b
$ String -> NonEmpty Char
forall a. HasCallStack => [a] -> NonEmpty a
NE.fromList String
xs]
        nam_ :: String -> val
nam_ String
xs = val
forall a. Default a => a
def val -> Ann -> val
forall val. Data val => val -> Ann -> val
&= Ann
explicit val -> Ann -> val
forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
xs

-- | Where should we find the configuration files?
--   Either we use the implicit search, or we follow the cmdGivenHints
--   We want more important hints to go last, since they override
cmdHintFiles :: Cmd -> IO [(FilePath, Maybe String)]
cmdHintFiles :: Cmd -> IO [(String, Maybe String)]
cmdHintFiles Cmd
cmd = do
    let explicit :: [String]
explicit = Cmd -> [String]
cmdGivenHints Cmd
cmd
    [String]
bad <- (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (IO Bool -> IO Bool
forall (m :: * -> *). Functor m => m Bool -> m Bool
notM (IO Bool -> IO Bool) -> (String -> IO Bool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist) [String]
explicit
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
bad [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        String -> IO ()
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (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
"Failed to find requested hint files:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
"  "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
bad

    -- if the user has given any explicit hints, ignore the local ones
    Maybe String
implicit <- if [String]
explicit [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
                  Bool -> Bool -> Bool
|| Cmd -> [String]
cmdGenerateMdSummary Cmd
cmd [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
                  Bool -> Bool -> Bool
|| Cmd -> [String]
cmdGenerateJsonSummary Cmd
cmd [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= []
                  Bool -> Bool -> Bool
|| Cmd -> [Severity]
cmdGenerateExhaustiveConf Cmd
cmd [Severity] -> [Severity] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing else do
        -- we follow the stylish-haskell config file search policy
        -- 1) current directory or its ancestors; 2) home directory
        String
curdir <- IO String
getCurrentDirectory
        -- Ignores home directory when it isn't present.
        [String]
home <- IO [String] -> (IOError -> IO [String]) -> IO [String]
forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError ((String -> [String] -> [String]
forall a. a -> [a] -> [a]
:[]) (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory) (IO [String] -> IOError -> IO [String]
forall a b. a -> b -> a
const (IO [String] -> IOError -> IO [String])
-> IO [String] -> IOError -> IO [String]
forall a b. (a -> b) -> a -> b
$ [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
        (String -> IO Bool) -> [String] -> IO (Maybe String)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM String -> IO Bool
doesFileExist ([String] -> IO (Maybe String)) -> [String] -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$
            (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
</> String
".hlint.yaml") (String -> [String]
ancestors String
curdir [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
home) -- to match Stylish Haskell
    [(String, Maybe String)] -> IO [(String, Maybe String)]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(String, Maybe String)] -> IO [(String, Maybe String)])
-> [(String, Maybe String)] -> IO [(String, Maybe String)]
forall a b. (a -> b) -> a -> b
$ (String, Maybe String)
hlintYaml (String, Maybe String)
-> [(String, Maybe String)] -> [(String, Maybe String)]
forall a. a -> [a] -> [a]
: (String -> (String, Maybe String))
-> [String] -> [(String, Maybe String)]
forall a b. (a -> b) -> [a] -> [b]
map (,Maybe String
forall a. Maybe a
Nothing) (Maybe String -> [String]
forall a. Maybe a -> [a]
maybeToList Maybe String
implicit [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
explicit)
    where
        ancestors :: String -> [String]
ancestors = [String] -> [String]
forall a. HasCallStack => [a] -> [a]
init ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String] -> String) -> [[String]] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
joinPath ([[String]] -> [String])
-> (String -> [[String]]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[String]] -> [[String]]
forall a. [a] -> [a]
reverse ([[String]] -> [[String]])
-> (String -> [[String]]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. [a] -> [[a]]
inits ([String] -> [[String]])
-> (String -> [String]) -> String -> [[String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
splitPath

cmdExtensions :: Cmd -> (Maybe Language, ([Extension], [Extension]))
cmdExtensions :: Cmd -> (Maybe Language, ([Extension], [Extension]))
cmdExtensions = [String] -> (Maybe Language, ([Extension], [Extension]))
getExtensions ([String] -> (Maybe Language, ([Extension], [Extension])))
-> (Cmd -> [String])
-> Cmd
-> (Maybe Language, ([Extension], [Extension]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cmd -> [String]
cmdLanguage


cmdCpp :: Cmd -> CppFlags
cmdCpp :: Cmd -> CppFlags
cmdCpp Cmd
cmd
    | Cmd -> Bool
cmdCppSimple Cmd
cmd = CppFlags
CppSimple
    | Bool
otherwise = CpphsOptions -> CppFlags
Cpphs CpphsOptions
defaultCpphsOptions
        {boolopts=defaultBoolOptions{hashline=False, stripC89=True, ansi=cmdCppAnsi cmd}
        ,includes = cmdCppInclude cmd
        ,preInclude = cmdCppFile cmd
        ,defines = ("__HLINT__","1") : [(a,drop1 b) | x <- cmdCppDefine cmd, let (a,b) = break (== '=') x] ++ [("__GLASGOW_HASKELL__", show (__GLASGOW_HASKELL__ :: Int))]
        }


-- | Determines whether to use colour or not.
cmdUseColour :: Cmd -> IO Bool
cmdUseColour :: Cmd -> IO Bool
cmdUseColour Cmd
cmd = do
  -- https://no-color.org
  -- if NO_COLOR is set, regardless of value, we do not colour output.
  Maybe String
noColor <- String -> IO (Maybe String)
lookupEnv String
"NO_COLOR"
  case Cmd -> ColorMode
cmdColor Cmd
cmd of
    ColorMode
Always -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    ColorMode
Never  -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
    ColorMode
Auto   -> do
      Bool
supportsANSI <- Handle -> IO Bool
hSupportsANSI Handle
stdout
      Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ Bool
supportsANSI Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing Maybe String
noColor

String
"." <\> :: String -> String -> String
<\> String
x = String
x
String
x <\> String
y = String
x String -> String -> String
</> String
y


resolveFile
    :: Cmd
    -> Maybe FilePath -- ^ Temporary file
    -> FilePath       -- ^ File to resolve, may be "-" for stdin
    -> IO [FilePath]
resolveFile :: Cmd -> Maybe String -> String -> IO [String]
resolveFile Cmd
cmd = (String -> Bool)
-> [String] -> [String] -> Maybe String -> String -> IO [String]
getFile ([String] -> String -> Bool
toPredicate ([String] -> String -> Bool) -> [String] -> String -> Bool
forall a b. (a -> b) -> a -> b
$ Cmd -> [String]
cmdIgnoreGlob Cmd
cmd) (Cmd -> [String]
cmdPath Cmd
cmd) (Cmd -> [String]
cmdExtension Cmd
cmd)
    where
        toPredicate :: [FilePattern] -> FilePath -> Bool
        toPredicate :: [String] -> String -> Bool
toPredicate [] = Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
False
        toPredicate [String]
globs = \String
x -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [((), (), [String])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([((), (), [String])] -> Bool) -> [((), (), [String])] -> Bool
forall a b. (a -> b) -> a -> b
$ [((), String)] -> [((), (), [String])]
forall {b}. [(b, String)] -> [((), b, [String])]
m [((), String -> String
cleanup String
x)]
            where m :: [(b, String)] -> [((), b, [String])]
m = [((), String)] -> [(b, String)] -> [((), b, [String])]
forall a b. [(a, String)] -> [(b, String)] -> [(a, b, [String])]
matchMany ((String -> ((), String)) -> [String] -> [((), String)]
forall a b. (a -> b) -> [a] -> [b]
map ((),) [String]
globs)

        cleanup :: FilePath -> FilePath
        cleanup :: String -> String
cleanup (Char
'.':Char
x:String
xs) | Char -> Bool
isPathSeparator Char
x, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
xs = String
xs
        cleanup String
x = String
x


getFile :: (FilePath -> Bool) -> [FilePath] -> [String] -> Maybe FilePath -> FilePath -> IO [FilePath]
getFile :: (String -> Bool)
-> [String] -> [String] -> Maybe String -> String -> IO [String]
getFile String -> Bool
_ [String]
path [String]
_ (Just String
tmpfile) String
"-" =
    -- make sure we don't reencode any Unicode
    IO ByteString
BS.getContents IO ByteString -> (ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> IO ()
BS.writeFile String
tmpfile IO () -> IO [String] -> IO [String]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
tmpfile]
getFile String -> Bool
_ [String]
path [String]
_ Maybe String
Nothing String
"-" = [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"-"]
getFile String -> Bool
_ [] [String]
exts Maybe String
_ String
file = String -> IO [String]
forall a. String -> IO a
exitMessage (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
"Couldn't find file: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
file
getFile String -> Bool
ignore (String
p:[String]
ath) [String]
exts Maybe String
t String
file = do
    Bool
isDir <- String -> IO Bool
doesDirectoryExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
<\> String
file
    if Bool
isDir then do
        let ignoredDirectories :: [String]
ignoredDirectories = [String
"dist", String
"dist-newstyle"]
            avoidDir :: String -> Bool
avoidDir String
x = let y :: String
y = String -> String
takeFileName String
x in String
"_" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y Bool -> Bool -> Bool
|| (String
"." String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') String
y)) Bool -> Bool -> Bool
|| String
y String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ignoredDirectories Bool -> Bool -> Bool
|| String -> Bool
ignore String
x
            avoidFile :: String -> Bool
avoidFile String
x = let y :: String
y = String -> String
takeFileName String
x in String
"." String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y Bool -> Bool -> Bool
|| String -> Bool
ignore String
x
        [String]
xs <- (String -> IO Bool) -> String -> IO [String]
listFilesInside (Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> IO Bool) -> (String -> Bool) -> String -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
avoidDir) (String -> IO [String]) -> String -> IO [String]
forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
<\> String
file
        [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
x | String
x <- [String]
xs, String -> String
forall a. [a] -> [a]
drop1 (String -> String
takeExtension String
x) String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
exts, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
avoidFile String
x]
     else do
        Bool
isFil <- String -> IO Bool
doesFileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
<\> String
file
        if Bool
isFil then
            [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
p String -> String -> String
<\> String
file | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ String -> Bool
ignore (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
<\> String
file]
         else do
            Maybe String
res <- String -> [String] -> String -> IO (Maybe String)
getModule String
p [String]
exts String
file
            case Maybe String
res of
                Just String
x -> [String] -> IO [String]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
x]
                Maybe String
Nothing -> (String -> Bool)
-> [String] -> [String] -> Maybe String -> String -> IO [String]
getFile String -> Bool
ignore [String]
ath [String]
exts Maybe String
t String
file


getModule :: FilePath -> [String] -> FilePath -> IO (Maybe FilePath)
getModule :: String -> [String] -> String -> IO (Maybe String)
getModule String
path [String]
exts String
x | Bool -> Bool
not ((Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
x) Bool -> Bool -> Bool
&& (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all String -> Bool
isMod [String]
xs = [String] -> IO (Maybe String)
f [String]
exts
    where
        xs :: [String]
xs = String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' then Char
' ' else Char
x) String
x
        isMod :: String -> Bool
isMod (Char
x:String
xs) = Char -> Bool
isUpper Char
x Bool -> Bool -> Bool
&& (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
x -> Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
xs
        isMod String
_ = Bool
False
        pre :: String
pre = String
path String -> String -> String
<\> [String] -> String
joinPath [String]
xs

        f :: [String] -> IO (Maybe String)
f [] = Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing
        f (String
x:[String]
xs) = do
            let s :: String
s = String
pre String -> String -> String
<.> String
x
            Bool
b <- String -> IO Bool
doesFileExist String
s
            if Bool
b then Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just String
s else [String] -> IO (Maybe String)
f [String]
xs
getModule String
_ [String]
_ String
_ = Maybe String -> IO (Maybe String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing


getExtensions :: [String] -> (Maybe Language, ([Extension], [Extension]))
getExtensions :: [String] -> (Maybe Language, ([Extension], [Extension]))
getExtensions [String]
args = (Maybe Language
lang, (([Extension], [Extension])
 -> String -> ([Extension], [Extension]))
-> ([Extension], [Extension])
-> [String]
-> ([Extension], [Extension])
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ([Extension], [Extension]) -> String -> ([Extension], [Extension])
f ([Extension]
startExts, []) [String]
exts)
  where
        -- If a language specifier is provided e.g. Haskell98 or
        -- Haskell2010 or GHC2021, then it represents a specific set
        -- of extensions which we default enable.

        -- If no language specifier is provided we construct our own
        -- set of extensions to default enable. The set that we
        -- construct default enables more extensions than GHC would
        -- default enable were it to be invoked without an explicit
        -- language specifier given.
        startExts :: [Extension]
        startExts :: [Extension]
startExts = case Maybe Language
lang of
          Maybe Language
Nothing -> [Extension]
defaultExtensions
          Just Language
_ -> Maybe Language -> [Extension]
GHC.Driver.Session.languageExtensions Maybe Language
lang

        -- If multiple languages are given, the last language "wins".
        lang :: Maybe Language
        lang :: Maybe Language
lang = Maybe Language -> Language
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Language -> Language)
-> (([String], String) -> Maybe Language)
-> ([String], String)
-> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [(String, Language)] -> Maybe Language)
-> [(String, Language)] -> String -> Maybe Language
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [(String, Language)] -> Maybe Language
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String, Language)]
ls (String -> Maybe Language)
-> (([String], String) -> String)
-> ([String], String)
-> Maybe Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([String], String) -> String
forall a b. (a, b) -> b
snd (([String], String) -> Language)
-> Maybe ([String], String) -> Maybe Language
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String] -> Maybe ([String], String)
forall a. [a] -> Maybe ([a], a)
unsnoc [String]
langs

        langs, exts :: [String]
        ([String]
langs, [String]
exts) = (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (Maybe Language -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Language -> Bool)
-> (String -> Maybe Language) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [(String, Language)] -> Maybe Language)
-> [(String, Language)] -> String -> Maybe Language
forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> [(String, Language)] -> Maybe Language
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String, Language)]
ls) [String]
args
        ls :: [(String, Language)]
ls = [ (Language -> String
forall a. Show a => a -> String
show Language
x, Language
x) | Language
x <- [Language
Haskell98, Language
Haskell2010 , Language
GHC2021] ]

        f :: ([Extension], [Extension]) -> String -> ([Extension], [Extension])
        f :: ([Extension], [Extension]) -> String -> ([Extension], [Extension])
f ([Extension]
a, [Extension]
e) (Char
'N':Char
'o':String
x) | Just Extension
x <- String -> Maybe Extension
GhclibParserEx.readExtension String
x, let xs :: [Extension]
xs = Extension -> [Extension]
expandDisable Extension
x = ([Extension] -> [Extension] -> [Extension]
deletes [Extension]
xs [Extension]
a, [Extension]
xs [Extension] -> [Extension] -> [Extension]
forall a. [a] -> [a] -> [a]
++ [Extension] -> [Extension] -> [Extension]
deletes [Extension]
xs [Extension]
e)
        f ([Extension]
a, [Extension]
e) String
x | Just Extension
x <- String -> Maybe Extension
GhclibParserEx.readExtension String
x = (Extension
x Extension -> [Extension] -> [Extension]
forall a. a -> [a] -> [a]
: Extension -> [Extension] -> [Extension]
forall a. Eq a => a -> [a] -> [a]
delete Extension
x [Extension]
a, Extension -> [Extension] -> [Extension]
forall a. Eq a => a -> [a] -> [a]
delete Extension
x [Extension]
e)
        f ([Extension]
a, [Extension]
e) String
x = String -> ([Extension], [Extension])
forall a. HasCallStack => String -> a
error (String -> ([Extension], [Extension]))
-> String -> ([Extension], [Extension])
forall a b. (a -> b) -> a -> b
$ String
"Unknown extension: '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'"

        deletes :: [Extension] -> [Extension] -> [Extension]
        deletes :: [Extension] -> [Extension] -> [Extension]
deletes [] [Extension]
ys = [Extension]
ys
        deletes (Extension
x : [Extension]
xs) [Extension]
ys = [Extension] -> [Extension] -> [Extension]
deletes [Extension]
xs ([Extension] -> [Extension]) -> [Extension] -> [Extension]
forall a b. (a -> b) -> a -> b
$ Extension -> [Extension] -> [Extension]
forall a. Eq a => a -> [a] -> [a]
delete Extension
x [Extension]
ys

        -- if you disable a feature that implies another feature, sometimes we should disable both
        -- e.g. no one knows what TemplateHaskellQuotes is https://github.com/ndmitchell/hlint/issues/1038
        expandDisable :: Extension -> [Extension]
        expandDisable :: Extension -> [Extension]
expandDisable Extension
TemplateHaskell = [Extension
TemplateHaskell, Extension
TemplateHaskellQuotes]
        expandDisable Extension
x = [Extension
x]