module Grep(runGrep) where

import Hint.All
import Apply
import Config.Type
import GHC.All
import Control.Monad
import Data.List
import Util
import Idea

import qualified GHC.Hs as GHC
import qualified BasicTypes as GHC
import qualified Outputable
import qualified ErrUtils
import Lexer
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
import SrcLoc as GHC hiding (mkSrcSpan)
import GHC.Util.DynFlags
import Bag

runGrep :: String -> ParseFlags -> [FilePath] -> IO ()
runGrep :: String -> ParseFlags -> [String] -> IO ()
runGrep String
patt ParseFlags
flags [String]
files = do
    LHsExpr GhcPs
exp <- case ParseFlags -> String -> ParseResult (LHsExpr GhcPs)
parseExpGhcWithMode ParseFlags
flags String
patt of
        POk PState
_ LHsExpr GhcPs
a -> LHsExpr GhcPs -> IO (LHsExpr GhcPs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure LHsExpr GhcPs
a
        PFailed PState
ps -> String -> IO (LHsExpr GhcPs)
forall a. String -> IO a
exitMessage (String -> IO (LHsExpr GhcPs)) -> String -> IO (LHsExpr GhcPs)
forall a b. (a -> b) -> a -> b
$
          let (WarningMessages
_, WarningMessages
errs) = PState -> DynFlags -> (WarningMessages, WarningMessages)
getMessages PState
ps DynFlags
baseDynFlags
              errMsg :: ErrMsg
errMsg = [ErrMsg] -> ErrMsg
forall a. [a] -> a
head (WarningMessages -> [ErrMsg]
forall a. Bag a -> [a]
bagToList WarningMessages
errs)
              msg :: String
msg = DynFlags -> SDoc -> String
Outputable.showSDoc DynFlags
baseDynFlags (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ ErrMsg -> SDoc
ErrUtils.pprLocErrMsg ErrMsg
errMsg
          in String
"Failed to parse " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
", when parsing:\n " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
patt
    let ghcUnit :: LHsExpr GhcPs
ghcUnit = SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a. HasSrcSpan a => SrcSpanLess a -> a
GHC.noLoc (SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs)
-> SrcSpanLess (LHsExpr GhcPs) -> LHsExpr GhcPs
forall a b. (a -> b) -> a -> b
$ XExplicitTuple GhcPs -> [LHsTupArg GhcPs] -> Boxity -> HsExpr GhcPs
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
GHC.ExplicitTuple NoExtField
XExplicitTuple GhcPs
GHC.noExtField [] Boxity
GHC.Boxed
    let rule :: Hint
rule = [HintRule] -> Hint
hintRules [Severity
-> String
-> [Note]
-> Scope
-> HsExtendInstances (LHsExpr GhcPs)
-> HsExtendInstances (LHsExpr GhcPs)
-> Maybe (HsExtendInstances (LHsExpr GhcPs))
-> HintRule
HintRule Severity
Suggestion String
"grep" [] Scope
forall a. Monoid a => a
mempty (LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances LHsExpr GhcPs
exp) (LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances LHsExpr GhcPs
ghcUnit) Maybe (HsExtendInstances (LHsExpr GhcPs))
forall a. Maybe a
Nothing]
    [String] -> (String -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
files ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
file -> do
        Either ParseError ModuleEx
res <- ParseFlags
-> String -> Maybe String -> IO (Either ParseError ModuleEx)
parseModuleEx ParseFlags
flags String
file Maybe String
forall a. Maybe a
Nothing
        case Either ParseError ModuleEx
res of
            Left (ParseError SrcSpan
sl String
msg String
ctxt) ->
                Idea -> IO ()
forall a. Show a => a -> IO ()
print (Idea -> IO ()) -> Idea -> IO ()
forall a b. (a -> b) -> a -> b
$ Severity
-> String -> SrcSpan -> String -> Maybe String -> [Note] -> Idea
rawIdeaN Severity
Error (if String
"Parse error" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
msg then String
msg else String
"Parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg) SrcSpan
sl String
ctxt Maybe String
forall a. Maybe a
Nothing []
            Right ModuleEx
m ->
                [Idea] -> (Idea -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Classify] -> Hint -> [ModuleEx] -> [Idea]
applyHints [] Hint
rule [ModuleEx
m]) ((Idea -> IO ()) -> IO ()) -> (Idea -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Idea
i ->
                    Idea -> IO ()
forall a. Show a => a -> IO ()
print Idea
i{ideaHint :: String
ideaHint=String
"", ideaTo :: Maybe String
ideaTo=Maybe String
forall a. Maybe a
Nothing}