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 ]