module Splint where import qualified Bag as GHC import qualified ErrUtils as GHC import qualified GhcPlugins as GHC import qualified Language.Haskell.HLint as HLint import qualified Splint.Settings as Settings plugin :: GHC.Plugin plugin :: Plugin plugin = Plugin GHC.defaultPlugin { parsedResultAction :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule GHC.parsedResultAction = [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule action , pluginRecompile :: [CommandLineOption] -> IO PluginRecompile GHC.pluginRecompile = [CommandLineOption] -> IO PluginRecompile GHC.purePlugin } action :: [GHC.CommandLineOption] -> GHC.ModSummary -> GHC.HsParsedModule -> GHC.Hsc GHC.HsParsedModule action :: [CommandLineOption] -> ModSummary -> HsParsedModule -> Hsc HsParsedModule action [CommandLineOption] commandLineOptions ModSummary modSummary HsParsedModule hsParsedModule = do (ParseFlags parseFlags, [Classify] classifies, Hint hint) <- IO (ParseFlags, [Classify], Hint) -> Hsc (ParseFlags, [Classify], Hint) forall (m :: * -> *) a. MonadIO m => IO a -> m a GHC.liftIO (IO (ParseFlags, [Classify], Hint) -> Hsc (ParseFlags, [Classify], Hint)) -> IO (ParseFlags, [Classify], Hint) -> Hsc (ParseFlags, [Classify], Hint) forall a b. (a -> b) -> a -> b $ [CommandLineOption] -> IO (ParseFlags, [Classify], Hint) Settings.load [CommandLineOption] commandLineOptions ModuleEx moduleEx <- ParseFlags -> ModSummary -> HsParsedModule -> Hsc ModuleEx parse ParseFlags parseFlags ModSummary modSummary HsParsedModule hsParsedModule DynFlags dynFlags <- Hsc DynFlags forall (m :: * -> *). HasDynFlags m => m DynFlags GHC.getDynFlags IO () -> Hsc () forall (m :: * -> *) a. MonadIO m => IO a -> m a GHC.liftIO (IO () -> Hsc ()) -> ([Idea] -> IO ()) -> [Idea] -> Hsc () forall b c a. (b -> c) -> (a -> b) -> a -> c . DynFlags -> Bag WarnMsg -> IO () GHC.printOrThrowWarnings DynFlags dynFlags (Bag WarnMsg -> IO ()) -> ([Idea] -> Bag WarnMsg) -> [Idea] -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . [WarnMsg] -> Bag WarnMsg forall a. [a] -> Bag a GHC.listToBag ([WarnMsg] -> Bag WarnMsg) -> ([Idea] -> [WarnMsg]) -> [Idea] -> Bag WarnMsg forall b c a. (b -> c) -> (a -> b) -> a -> c . (Idea -> WarnMsg) -> [Idea] -> [WarnMsg] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (DynFlags -> Idea -> WarnMsg ideaToWarnMsg DynFlags dynFlags) ([Idea] -> [WarnMsg]) -> ([Idea] -> [Idea]) -> [Idea] -> [WarnMsg] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Idea -> Bool) -> [Idea] -> [Idea] forall a. (a -> Bool) -> [a] -> [a] filter ((Severity -> Severity -> Bool forall a. Eq a => a -> a -> Bool /= Severity HLint.Ignore) (Severity -> Bool) -> (Idea -> Severity) -> Idea -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Idea -> Severity HLint.ideaSeverity) ([Idea] -> Hsc ()) -> [Idea] -> Hsc () forall a b. (a -> b) -> a -> b $ [Classify] -> Hint -> [ModuleEx] -> [Idea] HLint.applyHints [Classify] classifies Hint hint [ModuleEx moduleEx] HsParsedModule -> Hsc HsParsedModule forall (f :: * -> *) a. Applicative f => a -> f a pure HsParsedModule hsParsedModule ideaToWarnMsg :: GHC.DynFlags -> HLint.Idea -> GHC.WarnMsg ideaToWarnMsg :: DynFlags -> Idea -> WarnMsg ideaToWarnMsg DynFlags dynFlags Idea idea = let mkErrMsg :: DynFlags -> SrcSpan -> MsgDoc -> WarnMsg mkErrMsg = case Idea -> Severity HLint.ideaSeverity Idea idea of Severity HLint.Error -> DynFlags -> SrcSpan -> MsgDoc -> WarnMsg GHC.mkPlainErrMsg Severity _ -> DynFlags -> SrcSpan -> MsgDoc -> WarnMsg GHC.mkPlainWarnMsg srcSpan :: SrcSpan srcSpan = case SrcSpan -> Maybe (CommandLineOption, (Int, Int), (Int, Int)) HLint.unpackSrcSpan (SrcSpan -> Maybe (CommandLineOption, (Int, Int), (Int, Int))) -> SrcSpan -> Maybe (CommandLineOption, (Int, Int), (Int, Int)) forall a b. (a -> b) -> a -> b $ Idea -> SrcSpan HLint.ideaSpan Idea idea of Maybe (CommandLineOption, (Int, Int), (Int, Int)) Nothing -> SrcSpan GHC.noSrcSpan Just (CommandLineOption file, (Int startLine, Int startColumn), (Int endLine, Int endColumn)) -> SrcLoc -> SrcLoc -> SrcSpan GHC.mkSrcSpan (FastString -> Int -> Int -> SrcLoc GHC.mkSrcLoc (CommandLineOption -> FastString GHC.mkFastString CommandLineOption file) Int startLine Int startColumn) (FastString -> Int -> Int -> SrcLoc GHC.mkSrcLoc (CommandLineOption -> FastString GHC.mkFastString CommandLineOption file) Int endLine Int endColumn) msgDoc :: MsgDoc msgDoc = Idea -> MsgDoc ideaToMsgDoc Idea idea in DynFlags -> SrcSpan -> MsgDoc -> WarnMsg mkErrMsg DynFlags dynFlags SrcSpan srcSpan MsgDoc msgDoc ideaToMsgDoc :: HLint.Idea -> GHC.MsgDoc ideaToMsgDoc :: Idea -> MsgDoc ideaToMsgDoc Idea idea = [MsgDoc] -> MsgDoc GHC.vcat [ CommandLineOption -> MsgDoc GHC.text (CommandLineOption -> MsgDoc) -> CommandLineOption -> MsgDoc forall a b. (a -> b) -> a -> b $ Idea -> CommandLineOption HLint.ideaHint Idea idea , case Idea -> Maybe CommandLineOption HLint.ideaTo Idea idea of Just CommandLineOption to | Bool -> Bool not (Bool -> Bool) -> Bool -> Bool forall a b. (a -> b) -> a -> b $ CommandLineOption -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null CommandLineOption to -> CommandLineOption -> MsgDoc GHC.text (CommandLineOption -> MsgDoc) -> CommandLineOption -> MsgDoc forall a b. (a -> b) -> a -> b $ CommandLineOption "Perhaps: " CommandLineOption -> CommandLineOption -> CommandLineOption forall a. Semigroup a => a -> a -> a <> CommandLineOption to Maybe CommandLineOption _ -> MsgDoc GHC.empty , [MsgDoc] -> MsgDoc GHC.vcat ([MsgDoc] -> MsgDoc) -> ([Note] -> [MsgDoc]) -> [Note] -> MsgDoc forall b c a. (b -> c) -> (a -> b) -> a -> c . (Note -> MsgDoc) -> [Note] -> [MsgDoc] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (CommandLineOption -> MsgDoc GHC.text (CommandLineOption -> MsgDoc) -> (Note -> CommandLineOption) -> Note -> MsgDoc forall b c a. (b -> c) -> (a -> b) -> a -> c . CommandLineOption -> CommandLineOption -> CommandLineOption forall a. Monoid a => a -> a -> a mappend CommandLineOption "Note: " (CommandLineOption -> CommandLineOption) -> (Note -> CommandLineOption) -> Note -> CommandLineOption forall b c a. (b -> c) -> (a -> b) -> a -> c . Note -> CommandLineOption forall a. Show a => a -> CommandLineOption show) ([Note] -> MsgDoc) -> [Note] -> MsgDoc forall a b. (a -> b) -> a -> b $ Idea -> [Note] HLint.ideaNote Idea idea ] parse :: HLint.ParseFlags -> GHC.ModSummary -> GHC.HsParsedModule -> GHC.Hsc HLint.ModuleEx parse :: ParseFlags -> ModSummary -> HsParsedModule -> Hsc ModuleEx parse ParseFlags _ ModSummary _ HsParsedModule hsParsedModule = do let apiAnns :: ApiAnns apiAnns = HsParsedModule -> ApiAnns GHC.hpm_annotations HsParsedModule hsParsedModule hsModule :: Located (HsModule GhcPs) hsModule = HsParsedModule -> Located (HsModule GhcPs) GHC.hpm_module HsParsedModule hsParsedModule ModuleEx -> Hsc ModuleEx forall (f :: * -> *) a. Applicative f => a -> f a pure (ModuleEx -> Hsc ModuleEx) -> ModuleEx -> Hsc ModuleEx forall a b. (a -> b) -> a -> b $ ApiAnns -> Located (HsModule GhcPs) -> ModuleEx HLint.createModuleEx ApiAnns apiAnns Located (HsModule GhcPs) hsModule