{-# 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.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 = forall a. [String] -> IO a -> IO a
withArgs (forall a b. (a -> b) -> [a] -> [b]
map String -> String
f [String]
args) forall a b. (a -> b) -> a -> b
$ Cmd -> IO Cmd
automatic forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Mode (CmdArgs a) -> IO a
cmdArgsRun Mode (CmdArgs Cmd)
mode
where f :: String -> String
f String
x = if String
x forall a. Eq a => a -> a -> Bool
== String
"-?" Bool -> Bool -> Bool
|| String
x 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 forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {f :: * -> *}. Applicative f => Cmd -> f Cmd
path forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Cmd -> IO Cmd
git forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {f :: * -> *}. Applicative f => Cmd -> f Cmd
extension Cmd
cmd
where
path :: Cmd -> f Cmd
path Cmd
cmd = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Cmd -> [String]
cmdPath Cmd
cmd then Cmd
cmd{cmdPath :: [String]
cmdPath=[String
"."]} else Cmd
cmd
extension :: Cmd -> f Cmd
extension Cmd
cmd = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ Cmd -> [String]
cmdExtension Cmd
cmd then Cmd
cmd{cmdExtension :: [String]
cmdExtension=[String
"hs",String
"lhs"]} else Cmd
cmd
dataDir :: Cmd -> IO Cmd
dataDir Cmd
cmd
| Cmd -> String
cmdDataDir Cmd
cmd forall a. Eq a => a -> a -> Bool
/= String
"" = 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd{cmdDataDir :: String
cmdDataDir=String
x} else do
String
exe <- IO String
getExecutablePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd{cmdDataDir :: String
cmdDataDir = String -> String
takeDirectory String
exe String -> String -> String
</> String
"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 -> 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"] forall a. [a] -> [a] -> [a]
++
forall a b. (a -> b) -> [a] -> [b]
map (String
"*." forall a. [a] -> [a] -> [a]
++) (Cmd -> [String]
cmdExtension Cmd
cmd)
String
files <- forall a. String -> String -> IO a -> IO a
timedIO String
"Execute" ([String] -> String
unwords forall a b. (a -> b) -> a -> b
$ String
gitforall a. a -> [a] -> [a]
:[String]
args) forall a b. (a -> b) -> a -> b
$
String -> [String] -> String -> IO String
readProcess String
git [String]
args String
""
forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd{cmdFiles :: [String]
cmdFiles = Cmd -> [String]
cmdFiles Cmd
cmd forall a. [a] -> [a] -> [a]
++ String -> [String]
lines String
files}
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure Cmd
cmd
exitWithHelp :: IO a
exitWithHelp :: forall a. IO a
exitWithHelp = do
String -> IO ()
putStr forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a. [String] -> HelpFormat -> Mode a -> [Text]
helpText [] HelpFormat
HelpFormatAll Mode (CmdArgs Cmd)
mode
forall a. IO a
exitSuccess
data ColorMode
= Never
| Always
| Auto
deriving (Int -> ColorMode -> String -> String
[ColorMode] -> String -> String
ColorMode -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ColorMode] -> String -> String
$cshowList :: [ColorMode] -> String -> String
show :: ColorMode -> String
$cshow :: ColorMode -> String
showsPrec :: Int -> ColorMode -> String -> String
$cshowsPrec :: Int -> ColorMode -> String -> String
Show, Typeable, Typeable ColorMode
ColorMode -> DataType
ColorMode -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ColorMode -> m ColorMode
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColorMode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ColorMode -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ColorMode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ColorMode -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ColorMode -> r
gmapT :: (forall b. Data b => b -> b) -> ColorMode -> ColorMode
$cgmapT :: (forall b. Data b => b -> b) -> ColorMode -> ColorMode
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColorMode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ColorMode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ColorMode)
dataTypeOf :: ColorMode -> DataType
$cdataTypeOf :: ColorMode -> DataType
toConstr :: ColorMode -> Constr
$ctoConstr :: ColorMode -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ColorMode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMode -> c ColorMode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ColorMode -> c ColorMode
Data)
instance Default ColorMode where
def :: ColorMode
def = ColorMode
Auto
data Cmd
= CmdMain
{Cmd -> [String]
cmdFiles :: [FilePath]
,Cmd -> [String]
cmdReports :: [FilePath]
,Cmd -> [String]
cmdGivenHints :: [FilePath]
,Cmd -> [String]
cmdWithGroups :: [String]
,Cmd -> Bool
cmdGit :: Bool
,Cmd -> ColorMode
cmdColor :: ColorMode
,Cmd -> Int
cmdThreads :: Int
,Cmd -> [String]
cmdIgnore :: [String]
,Cmd -> Bool
cmdShowAll :: Bool
,Cmd -> Bool
cmdIgnoreSuggestions :: Bool
,Cmd -> [String]
cmdExtension :: [String]
,Cmd -> [String]
cmdLanguage :: [String]
,Cmd -> Bool
cmdCross :: Bool
,Cmd -> [String]
cmdFindHints :: [FilePath]
,Cmd -> String
cmdDataDir :: FilePath
,Cmd -> Bool
cmdDefault :: Bool
,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
,Cmd -> Bool
cmdCC :: Bool
,Cmd -> Bool
cmdSARIF :: Bool
,Cmd -> Bool
cmdNoSummary :: Bool
,Cmd -> [String]
cmdOnly :: [String]
,Cmd -> Bool
cmdNoExitCode :: Bool
,Cmd -> Bool
cmdTiming :: Bool
,Cmd -> Bool
cmdSerialise :: Bool
,Cmd -> Bool
cmdRefactor :: Bool
,Cmd -> String
cmdRefactorOptions :: String
,Cmd -> String
cmdWithRefactor :: FilePath
,Cmd -> [String]
cmdIgnoreGlob :: [FilePattern]
,Cmd -> [String]
cmdGenerateMdSummary :: [FilePath]
,Cmd -> [String]
cmdGenerateJsonSummary :: [FilePath]
,Cmd -> [Severity]
cmdGenerateExhaustiveConf :: [Severity]
,Cmd -> Bool
cmdTest :: Bool
}
deriving (Typeable Cmd
Cmd -> DataType
Cmd -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Cmd -> m Cmd
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cmd -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Cmd -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Cmd -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Cmd -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Cmd -> r
gmapT :: (forall b. Data b => b -> b) -> Cmd -> Cmd
$cgmapT :: (forall b. Data b => b -> b) -> Cmd -> Cmd
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cmd)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Cmd)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cmd)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Cmd)
dataTypeOf :: Cmd -> DataType
$cdataTypeOf :: Cmd -> DataType
toConstr :: Cmd -> Constr
$ctoConstr :: Cmd -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cmd
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Cmd
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cmd -> c Cmd
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Cmd -> c Cmd
Data,Typeable,Int -> Cmd -> String -> String
[Cmd] -> String -> String
Cmd -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Cmd] -> String -> String
$cshowList :: [Cmd] -> String -> String
show :: Cmd -> String
$cshow :: Cmd -> String
showsPrec :: Int -> Cmd -> String -> String
$cshowsPrec :: Int -> Cmd -> String -> String
Show)
mode :: Mode (CmdArgs Cmd)
mode = forall a. Data a => a -> Mode (CmdArgs a)
cmdArgsMode forall a b. (a -> b) -> a -> b
$ forall val. Data val => [val] -> val
modes
[CmdMain
{cmdFiles :: [String]
cmdFiles = forall a. Default a => a
def forall val. Data val => val -> Ann -> val
&= Ann
args forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"FILE/DIR"
,cmdReports :: [String]
cmdReports = forall {val}. (Data val, Default val) => String -> val
nam String
"report" forall val. Data val => val -> Ann -> val
&= forall a. (Show a, Typeable a) => a -> Ann
opt String
"report.html" forall val. Data val => val -> Ann -> val
&= Ann
typFile forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Generate a report in HTML"
,cmdGivenHints :: [String]
cmdGivenHints = forall {val}. (Data val, Default val) => String -> val
nam String
"hint" forall val. Data val => val -> Ann -> val
&= Ann
typFile forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Hint/ignore file to use"
,cmdWithGroups :: [String]
cmdWithGroups = forall {val}. (Data val, Default val) => String -> val
nam_ String
"with-group" forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"GROUP" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Extra hint groups to use"
,cmdGit :: Bool
cmdGit = forall {val}. (Data val, Default val) => String -> val
nam String
"git" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Run on files tracked by git"
,cmdColor :: ColorMode
cmdColor = forall {val}. (Data val, Default val) => String -> val
nam String
"colour" forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"color" forall val. Data val => val -> Ann -> val
&= forall a. (Show a, Typeable a) => a -> Ann
opt ColorMode
Always forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"always/never/auto" 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 forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"threads" forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"j" forall val. Data val => val -> Ann -> val
&= forall a. (Show a, Typeable a) => a -> Ann
opt (Int
0 :: Int) forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Number of threads to use (-j for all)"
,cmdIgnore :: [String]
cmdIgnore = forall {val}. (Data val, Default val) => String -> val
nam String
"ignore" forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"HINT" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Ignore a particular hint"
,cmdShowAll :: Bool
cmdShowAll = forall {val}. (Data val, Default val) => String -> val
nam String
"show" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Show all ignored ideas"
,cmdIgnoreSuggestions :: Bool
cmdIgnoreSuggestions = forall {val}. (Data val, Default val) => String -> val
nam_ String
"ignore-suggestions" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Ignore suggestions, only show warnings and errors"
,cmdExtension :: [String]
cmdExtension = forall {val}. (Data val, Default val) => String -> val
nam String
"extension" forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"EXT" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"File extensions to search (default hs/lhs)"
,cmdLanguage :: [String]
cmdLanguage = forall {val}. (Data val, Default val) => String -> val
nam_ String
"language" forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"X" forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"EXTENSION" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Language extensions (Arrows, NoCPP)"
,cmdCross :: Bool
cmdCross = forall {val}. (Data val, Default val) => String -> val
nam_ String
"cross" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Work between modules"
,cmdFindHints :: [String]
cmdFindHints = forall {val}. (Data val, Default val) => String -> val
nam String
"find" forall val. Data val => val -> Ann -> val
&= Ann
typFile forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Find hints in a Haskell file"
,cmdDataDir :: String
cmdDataDir = forall {val}. (Data val, Default val) => String -> val
nam_ String
"datadir" forall val. Data val => val -> Ann -> val
&= Ann
typDir forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Override the data directory"
,cmdDefault :: Bool
cmdDefault = forall {val}. (Data val, Default val) => String -> val
nam String
"default" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Print a default file to stdout"
,cmdPath :: [String]
cmdPath = forall {val}. (Data val, Default val) => String -> val
nam String
"path" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Directory in which to search for files"
,cmdCppDefine :: [String]
cmdCppDefine = forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-define" forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"NAME[=VALUE]" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"CPP #define"
,cmdCppInclude :: [String]
cmdCppInclude = forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-include" forall val. Data val => val -> Ann -> val
&= Ann
typDir forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"CPP include path"
,cmdCppFile :: [String]
cmdCppFile = forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-file" forall val. Data val => val -> Ann -> val
&= Ann
typFile forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"CPP pre-include file"
,cmdCppSimple :: Bool
cmdCppSimple = forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-simple" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Use a simple CPP (strip # lines)"
,cmdCppAnsi :: Bool
cmdCppAnsi = forall {val}. (Data val, Default val) => String -> val
nam_ String
"cpp-ansi" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Use CPP in ANSI compatibility mode"
,cmdJson :: Bool
cmdJson = forall {val}. (Data val, Default val) => String -> val
nam_ String
"json" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display hint data as JSON"
,cmdCC :: Bool
cmdCC = forall {val}. (Data val, Default val) => String -> val
nam_ String
"cc" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display hint data as Code Climate Issues"
,cmdSARIF :: Bool
cmdSARIF = forall {val}. (Data val, Default val) => String -> val
nam_ String
"sarif" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display hint data as SARIF"
,cmdNoSummary :: Bool
cmdNoSummary = forall {val}. (Data val, Default val) => String -> val
nam_ String
"no-summary" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Do not show summary information"
,cmdOnly :: [String]
cmdOnly = forall {val}. (Data val, Default val) => String -> val
nam String
"only" forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"HINT" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Specify which hints explicitly"
,cmdNoExitCode :: Bool
cmdNoExitCode = forall {val}. (Data val, Default val) => String -> val
nam_ String
"no-exit-code" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Do not give a negative exit if hints"
,cmdTiming :: Bool
cmdTiming = forall {val}. (Data val, Default val) => String -> val
nam_ String
"timing" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Display timing information"
,cmdSerialise :: Bool
cmdSerialise = forall {val}. (Data val, Default val) => String -> val
nam_ String
"serialise" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Serialise hint data for consumption by apply-refact"
,cmdRefactor :: Bool
cmdRefactor = forall {val}. (Data val, Default val) => String -> val
nam_ String
"refactor" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Automatically invoke `refactor` to apply hints"
,cmdRefactorOptions :: String
cmdRefactorOptions = forall {val}. (Data val, Default val) => String -> val
nam_ String
"refactor-options" forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"OPTIONS" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Options to pass to the `refactor` executable"
,cmdWithRefactor :: String
cmdWithRefactor = forall {val}. (Data val, Default val) => String -> val
nam_ String
"with-refactor" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Give the path to refactor"
,cmdIgnoreGlob :: [String]
cmdIgnoreGlob = forall {val}. (Data val, Default val) => String -> val
nam_ String
"ignore-glob" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Ignore paths matching glob pattern (e.g. foo/bar/*.hs)"
,cmdGenerateMdSummary :: [String]
cmdGenerateMdSummary = forall {val}. (Data val, Default val) => String -> val
nam_ String
"generate-summary" forall val. Data val => val -> Ann -> val
&= forall a. (Show a, Typeable a) => a -> Ann
opt String
"hints.md" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Generate a summary of available hints, in Markdown format"
,cmdGenerateJsonSummary :: [String]
cmdGenerateJsonSummary = forall {val}. (Data val, Default val) => String -> val
nam_ String
"generate-summary-json" forall val. Data val => val -> Ann -> val
&= forall a. (Show a, Typeable a) => a -> Ann
opt String
"hints.json" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Generate a summary of available hints, in JSON format"
,cmdGenerateExhaustiveConf :: [Severity]
cmdGenerateExhaustiveConf = forall {val}. (Data val, Default val) => String -> val
nam_ String
"generate-config" forall val. Data val => val -> Ann -> val
&= forall a. (Show a, Typeable a) => a -> Ann
opt Severity
Warning forall val. Data val => val -> Ann -> val
&= String -> Ann
typ String
"LEVEL" 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 = forall {val}. (Data val, Default val) => String -> val
nam_ String
"test" forall val. Data val => val -> Ann -> val
&= String -> Ann
help String
"Run the test suite"
} forall val. Data val => val -> Ann -> val
&= Ann
auto forall val. Data val => val -> Ann -> val
&= Ann
explicit forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
"lint"
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"]
] forall val. Data val => val -> Ann -> val
&= String -> Ann
program String
"hlint" forall val. Data val => val -> Ann -> val
&= Ann
verbosity
forall val. Data val => val -> Ann -> val
&= String -> Ann
summary (String
"HLint v" forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
version forall a. [a] -> [a] -> [a]
++ String
", (C) Neil Mitchell 2006-2023")
where
nam :: String -> val
nam String
xs = forall {val}. (Data val, Default val) => String -> val
nam_ String
xs forall val. Data val => val -> Ann -> val
&= String -> Ann
name [forall a. [a] -> a
head String
xs]
nam_ :: String -> val
nam_ String
xs = forall a. Default a => a
def forall val. Data val => val -> Ann -> val
&= Ann
explicit forall val. Data val => val -> Ann -> val
&= String -> Ann
name String
xs
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 <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (m :: * -> *). Functor m => m Bool -> m Bool
notM forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Bool
doesFileExist) [String]
explicit
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([String]
bad forall a. Eq a => a -> a -> Bool
/= []) forall a b. (a -> b) -> a -> b
$
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines forall a b. (a -> b) -> a -> b
$ String
"Failed to find requested hint files:" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (String
" "forall a. [a] -> [a] -> [a]
++) [String]
bad
Maybe String
implicit <- if [String]
explicit forall a. Eq a => a -> a -> Bool
/= []
Bool -> Bool -> Bool
|| Cmd -> [String]
cmdGenerateMdSummary Cmd
cmd forall a. Eq a => a -> a -> Bool
/= []
Bool -> Bool -> Bool
|| Cmd -> [String]
cmdGenerateJsonSummary Cmd
cmd forall a. Eq a => a -> a -> Bool
/= []
Bool -> Bool -> Bool
|| Cmd -> [Severity]
cmdGenerateExhaustiveConf Cmd
cmd forall a. Eq a => a -> a -> Bool
/= [] then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing else do
String
curdir <- IO String
getCurrentDirectory
[String]
home <- forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError ((forall a. a -> [a] -> [a]
:[]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO String
getHomeDirectory) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
findM String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
</> String
".hlint.yaml") (String -> [String]
ancestors String
curdir forall a. [a] -> [a] -> [a]
++ [String]
home)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (String, Maybe String)
hlintYaml forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (,forall a. Maybe a
Nothing) (forall a. Maybe a -> [a]
maybeToList Maybe String
implicit forall a. [a] -> [a] -> [a]
++ [String]
explicit)
where
ancestors :: String -> [String]
ancestors = forall a. [a] -> [a]
init forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map [String] -> String
joinPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [[a]]
inits 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 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 :: BoolOptions
boolopts=BoolOptions
defaultBoolOptions{hashline :: Bool
hashline=Bool
False, stripC89 :: Bool
stripC89=Bool
True, ansi :: Bool
ansi=Cmd -> Bool
cmdCppAnsi Cmd
cmd}
,includes :: [String]
includes = Cmd -> [String]
cmdCppInclude Cmd
cmd
,preInclude :: [String]
preInclude = Cmd -> [String]
cmdCppFile Cmd
cmd
,defines :: [(String, String)]
defines = (String
"__HLINT__",String
"1") forall a. a -> [a] -> [a]
: [(String
a,forall a. [a] -> [a]
drop1 String
b) | String
x <- Cmd -> [String]
cmdCppDefine Cmd
cmd, let (String
a,String
b) = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
== Char
'=') String
x] forall a. [a] -> [a] -> [a]
++ [(String
"__GLASGOW_HASKELL__", forall a. Show a => a -> String
show (__GLASGOW_HASKELL__ :: Int))]
}
cmdUseColour :: Cmd -> IO Bool
cmdUseColour :: Cmd -> IO Bool
cmdUseColour Cmd
cmd = do
Maybe String
noColor <- String -> IO (Maybe String)
lookupEnv String
"NO_COLOR"
case Cmd -> ColorMode
cmdColor Cmd
cmd of
ColorMode
Always -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
ColorMode
Never -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
ColorMode
Auto -> do
Bool
supportsANSI <- Handle -> IO Bool
hSupportsANSI Handle
stdout
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool
supportsANSI Bool -> Bool -> 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
-> FilePath
-> 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 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 [] = forall a b. a -> b -> a
const Bool
False
toPredicate [String]
globs = \String
x -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ forall {b}. [(b, String)] -> [((), b, [String])]
m [((), String -> String
cleanup String
x)]
where m :: [(b, String)] -> [((), b, [String])]
m = forall a b. [(a, String)] -> [(b, String)] -> [(a, b, [String])]
matchMany (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 forall a b. (a -> b) -> a -> b
$ 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
"-" =
IO ByteString
BS.getContents forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> ByteString -> IO ()
BS.writeFile String
tmpfile forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
tmpfile]
getFile String -> Bool
_ [String]
path [String]
_ Maybe String
Nothing String
"-" = forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
"-"]
getFile String -> Bool
_ [] [String]
exts Maybe String
_ String
file = forall a. String -> IO a
exitMessage forall a b. (a -> b) -> a -> b
$ String
"Couldn't find file: " 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 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
"_" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y Bool -> Bool -> Bool
|| (String
"." forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
y Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Char
'.') String
y)) Bool -> Bool -> Bool
|| String
y 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
"." 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 (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
avoidDir) forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
<\> String
file
forall (f :: * -> *) a. Applicative f => a -> f a
pure [String
x | String
x <- [String]
xs, forall a. [a] -> [a]
drop1 (String -> String
takeExtension String
x) forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
exts, Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ String -> Bool
avoidFile String
x]
else do
Bool
isFil <- String -> IO Bool
doesFileExist forall a b. (a -> b) -> a -> b
$ String
p String -> String -> String
<\> String
file
if Bool
isFil then forall (f :: * -> *) a. Applicative f => a -> f a
pure [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 -> 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 (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isSpace String
x) Bool -> Bool -> 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 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x 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
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
x -> Char -> Bool
isAlphaNum Char
x Bool -> Bool -> Bool
|| Char
x 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 [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
s else [String] -> IO (Maybe String)
f [String]
xs
getModule String
_ [String]
_ String
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
getExtensions :: [String] -> (Maybe Language, ([Extension], [Extension]))
getExtensions :: [String] -> (Maybe Language, ([Extension], [Extension]))
getExtensions [String]
args = (Maybe Language
lang, 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
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
lang :: Maybe Language
lang :: Maybe Language
lang = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String, Language)]
ls forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe ([a], a)
unsnoc [String]
langs
langs, exts :: [String]
([String]
langs, [String]
exts) = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(String, Language)]
ls) [String]
args
ls :: [(String, Language)]
ls = [ (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 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 forall a. a -> [a] -> [a]
: forall a. Eq a => a -> [a] -> [a]
delete Extension
x [Extension]
a, forall a. Eq a => a -> [a] -> [a]
delete Extension
x [Extension]
e)
f ([Extension]
a, [Extension]
e) String
x = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Unknown extension: '" forall a. [a] -> [a] -> [a]
++ String
x 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 forall a b. (a -> b) -> a -> b
$ forall a. Eq a => a -> [a] -> [a]
delete Extension
x [Extension]
ys
expandDisable :: Extension -> [Extension]
expandDisable :: Extension -> [Extension]
expandDisable Extension
TemplateHaskell = [Extension
TemplateHaskell, Extension
TemplateHaskellQuotes]
expandDisable Extension
x = [Extension
x]