module Grep(runGrep) where

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

import qualified HsSyn as GHC
import qualified BasicTypes as GHC
import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances
import SrcLoc as GHC hiding (mkSrcSpan)

runGrep :: String -> ParseFlags -> [FilePath] -> IO ()
runGrep :: String -> ParseFlags -> [String] -> IO ()
runGrep patt :: String
patt flags :: ParseFlags
flags files :: [String]
files = do
    Exp SrcSpanInfo
exp <- case String -> ParseResult (Exp SrcSpanInfo)
parseExp String
patt of
        ParseOk x :: Exp SrcSpanInfo
x -> Exp SrcSpanInfo -> IO (Exp SrcSpanInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Exp SrcSpanInfo
x
        ParseFailed sl :: SrcLoc
sl msg :: String
msg ->
            String -> IO (Exp SrcSpanInfo)
forall a. String -> IO a
exitMessage (String -> IO (Exp SrcSpanInfo)) -> String -> IO (Exp SrcSpanInfo)
forall a b. (a -> b) -> a -> b
$ (if "Parse error" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
msg then String
msg else "Parse error in pattern: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                          String
patt String -> String -> String
forall a. [a] -> [a] -> [a]
++ "\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                          Int -> Char -> String
forall a. Int -> a -> [a]
replicate (SrcLoc -> Int
srcColumn SrcLoc
sl Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) ' ' String -> String -> String
forall a. [a] -> [a] -> [a]
++ "^"
    let scope :: Scope
scope = Module SrcSpanInfo -> Scope
scopeCreate (Module SrcSpanInfo -> Scope) -> Module SrcSpanInfo -> Scope
forall a b. (a -> b) -> a -> b
$ SrcSpanInfo
-> Maybe (ModuleHead SrcSpanInfo)
-> [ModulePragma SrcSpanInfo]
-> [ImportDecl SrcSpanInfo]
-> [Decl SrcSpanInfo]
-> Module SrcSpanInfo
forall l.
l
-> Maybe (ModuleHead l)
-> [ModulePragma l]
-> [ImportDecl l]
-> [Decl l]
-> Module l
Module SrcSpanInfo
an Maybe (ModuleHead SrcSpanInfo)
forall a. Maybe a
Nothing [] [] []
    let unit :: LHsExpr GhcPs
unit = 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 NoExt
XExplicitTuple GhcPs
GHC.noExt [] Boxity
GHC.Boxed
    let rule :: Hint
rule = [HintRule] -> Hint
hintRules [Severity
-> String
-> Scope
-> Exp SrcSpanInfo
-> Exp SrcSpanInfo
-> Maybe (Exp SrcSpanInfo)
-> [Note]
-> HsExtendInstances Scope'
-> HsExtendInstances (LHsExpr GhcPs)
-> HsExtendInstances (LHsExpr GhcPs)
-> Maybe (HsExtendInstances (LHsExpr GhcPs))
-> HintRule
HintRule Severity
Suggestion "grep" Scope
scope Exp SrcSpanInfo
exp (SrcSpanInfo -> Boxed -> [Exp SrcSpanInfo] -> Exp SrcSpanInfo
forall l. l -> Boxed -> [Exp l] -> Exp l
Tuple SrcSpanInfo
an Boxed
Boxed []) Maybe (Exp SrcSpanInfo)
forall a. Maybe a
Nothing []
                         -- Todo : Replace these with "proper" GHC expressions.
                          (Scope' -> HsExtendInstances Scope'
forall a. a -> HsExtendInstances a
extendInstances Scope'
forall a. Monoid a => a
mempty) (LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances LHsExpr GhcPs
unit) (LHsExpr GhcPs -> HsExtendInstances (LHsExpr GhcPs)
forall a. a -> HsExtendInstances a
extendInstances LHsExpr GhcPs
unit) 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
$ \file :: 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 sl :: SrcLoc
sl msg :: String
msg ctxt :: 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 "Parse error" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
msg then String
msg else "Parse error: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg) (SrcLoc -> SrcLoc -> SrcSpan
mkSrcSpan SrcLoc
sl SrcLoc
sl) String
ctxt Maybe String
forall a. Maybe a
Nothing []
            Right m :: 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
$ \i :: Idea
i ->
                    Idea -> IO ()
forall a. Show a => a -> IO ()
print Idea
i{ideaHint :: String
ideaHint="", ideaTo :: Maybe String
ideaTo=Maybe String
forall a. Maybe a
Nothing}