module Splint where

import qualified GHC.Data.Bag as Bag
import qualified GHC.Driver.Errors as Errors
import qualified GHC.Hs as Hs
import qualified GHC.Plugins as Plugins
import qualified GHC.Types.Error as Error
import qualified GHC.Utils.Logger as Logger
import qualified Language.Haskell.HLint as HLint
import qualified Splint.Settings as Settings

plugin :: Plugins.Plugin
plugin :: Plugin
plugin = Plugin
Plugins.defaultPlugin
  { parsedResultAction :: [String] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
Plugins.parsedResultAction = [String] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedResultAction
  , pluginRecompile :: [String] -> IO PluginRecompile
Plugins.pluginRecompile = [String] -> IO PluginRecompile
Plugins.purePlugin
  }

parsedResultAction
  :: [Plugins.CommandLineOption]
  -> Plugins.ModSummary
  -> Hs.HsParsedModule
  -> Plugins.Hsc Hs.HsParsedModule
parsedResultAction :: [String] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule
parsedResultAction [String]
commandLineOptions ModSummary
_modSummary HsParsedModule
hsParsedModule = do
  (ParseFlags
_parseFlags, [Classify]
classifies, Hint
hint) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
Plugins.liftIO
    forall a b. (a -> b) -> a -> b
$ [String] -> IO (ParseFlags, [Classify], Hint)
Settings.load [String]
commandLineOptions
  Logger
logger <- forall (m :: * -> *). HasLogger m => m Logger
Logger.getLogger
  DynFlags
dynFlags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
Plugins.getDynFlags
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
Plugins.liftIO
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> DynFlags -> Bag WarnMsg -> IO ()
Errors.printOrThrowWarnings Logger
logger DynFlags
dynFlags
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Bag a
Bag.listToBag
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Idea -> WarnMsg
ideaToWarnMsg
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(/=) Severity
HLint.Ignore forall b c a. (b -> c) -> (a -> b) -> a -> c
. Idea -> Severity
HLint.ideaSeverity)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Classify] -> Hint -> [ModuleEx] -> [Idea]
HLint.applyHints [Classify]
classifies Hint
hint
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located HsModule -> ModuleEx
HLint.createModuleEx
    forall a b. (a -> b) -> a -> b
$ HsParsedModule -> Located HsModule
Hs.hpm_module HsParsedModule
hsParsedModule
  forall (f :: * -> *) a. Applicative f => a -> f a
pure HsParsedModule
hsParsedModule

ideaToWarnMsg :: HLint.Idea -> Error.WarnMsg
ideaToWarnMsg :: Idea -> WarnMsg
ideaToWarnMsg Idea
idea =
  SrcSpan -> SDoc -> WarnMsg
Error.mkPlainWarnMsg (Idea -> SrcSpan
ideaToSrcSpan Idea
idea) (Idea -> SDoc
ideaToSDoc Idea
idea)

ideaToSrcSpan :: HLint.Idea -> Plugins.SrcSpan
ideaToSrcSpan :: Idea -> SrcSpan
ideaToSrcSpan Idea
idea = case SrcSpan -> Maybe (String, (Int, Int), (Int, Int))
HLint.unpackSrcSpan forall a b. (a -> b) -> a -> b
$ Idea -> SrcSpan
HLint.ideaSpan Idea
idea of
  Maybe (String, (Int, Int), (Int, Int))
Nothing -> SrcSpan
Plugins.noSrcSpan
  Just (String
filePath, (Int
startLine, Int
startColumn), (Int
endLine, Int
endColumn)) ->
    let fastString :: FastString
fastString = String -> FastString
Plugins.mkFastString String
filePath
    in
      SrcLoc -> SrcLoc -> SrcSpan
Plugins.mkSrcSpan
        (FastString -> Int -> Int -> SrcLoc
Plugins.mkSrcLoc FastString
fastString Int
startLine Int
startColumn)
        (FastString -> Int -> Int -> SrcLoc
Plugins.mkSrcLoc FastString
fastString Int
endLine Int
endColumn)

ideaToSDoc :: HLint.Idea -> Error.SDoc
ideaToSDoc :: Idea -> SDoc
ideaToSDoc Idea
idea = [SDoc] -> SDoc
Plugins.vcat
  [ String -> SDoc
Plugins.text forall a b. (a -> b) -> a -> b
$ Idea -> String
HLint.ideaHint Idea
idea
  , case Idea -> Maybe String
HLint.ideaTo Idea
idea of
    Just String
to | Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
to -> String -> SDoc
Plugins.text forall a b. (a -> b) -> a -> b
$ String
"Perhaps: " forall a. Semigroup a => a -> a -> a
<> String
to
    Maybe String
_ -> SDoc
Plugins.empty
  , [SDoc] -> SDoc
Plugins.vcat
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> SDoc
Plugins.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => a -> a -> a
mappend String
"Note: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)
  forall a b. (a -> b) -> a -> b
$ Idea -> [Note]
HLint.ideaNote Idea
idea
  ]