hlint-plugin (empty) → 1.0.0
raw patch · 8 files changed
+566/−0 lines, 8 filesdep +basedep +containersdep +ghc
Dependencies added: base, containers, ghc, hlint
Files
- CHANGELOG.md +3/−0
- LICENSE +30/−0
- ghc90/HLint/Plugin.hs +87/−0
- ghc92/HLint/Plugin.hs +99/−0
- ghc94/HLint/Plugin.hs +121/−0
- ghc96/HLint/Plugin.hs +123/−0
- hlint-plugin.cabal +43/−0
- src/HLint/Plugin/Settings.hs +60/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+1.0.0++- Initial release
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2023, Mercury Technologies++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Mercury Technologies nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ ghc90/HLint/Plugin.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module provides a GHC plugin that you can use to run HLint on a+-- module+--+-- To do so, add this @hlint-plugin@ package as a build dependency of your+-- Haskell package and then add the GHC options @-fplugin HLint.Plugin@+-- To use this plugin, add this package as a build dependency and then enable+-- the following GHC options (typically in the @ghc-options:@ field of your+-- @.cabal@ file):+--+-- > -fplugin HLint.Plugin+--+-- You can pass command-line options to @hlint@ using @-fplugin-opt@, like+-- this:+--+-- > -fplugin HLint.Plugin -fplugin-opt='HLint.Plugin:--ignore=Redundant guard'+module HLint.Plugin+ ( -- * Plugin+ plugin+ ) where++import Control.Applicative (empty)+import GHC.Driver.Types (HsParsedModule(..))+import GHC.Plugins (DynFlags, Plugin(..))+import GHC.Utils.Error (WarnMsg)+import Language.Haskell.HLint (Idea(..))++import qualified GHC.Data.Bag as Bag+import qualified GHC.Plugins as Plugins+import qualified GHC.Utils.Error as Error+import qualified HLint.Plugin.Settings as Settings+import qualified Language.Haskell.HLint as HLint++-- | GHC plugin that runs HLint on a Haskell module after parsing the module+plugin :: Plugin+plugin = Plugins.defaultPlugin+ { parsedResultAction+ , pluginRecompile = Plugins.purePlugin+ }+ where+ parsedResultAction arguments _ hsParsedModule = do+ (_parseFlags, classifies, hint) <- do+ Plugins.liftIO (Settings.argsSettings arguments)++ let HsParsedModule{ hpm_annotations, hpm_module } = hsParsedModule++ dynFlags <- Plugins.getDynFlags++ let moduleEx = HLint.createModuleEx hpm_annotations hpm_module++ let ideas = HLint.applyHints classifies hint [moduleEx]++ let msgEnvelopes = concatMap (ideaToMsgEnvelope dynFlags) ideas++ let messages = Bag.listToBag msgEnvelopes++ Plugins.liftIO (Plugins.printOrThrowWarnings dynFlags messages)++ pure hsParsedModule++ideaToMsgEnvelope :: DynFlags -> Idea -> [WarnMsg]+ideaToMsgEnvelope dynFlags Idea{..} = do+ makeMessage <- case ideaSeverity of+ HLint.Ignore -> empty+ HLint.Suggestion -> pure Error.mkPlainWarnMsg+ HLint.Warning -> pure Error.mkPlainWarnMsg+ HLint.Error -> pure Error.mkPlainErrMsg++ return (makeMessage dynFlags ideaSpan sdoc)+ where+ sdoc = Plugins.vcat (sdocs0 <> sdocs1 <> sdocs2)+ where+ sdocs0 = [ Plugins.text ideaHint ]++ sdocs1 =+ case ideaTo of+ Nothing -> []+ Just "" -> []+ Just to -> [ Plugins.text ("Perhaps: " <> to) ]++ sdocs2 = do+ note <- ideaNote++ pure (Plugins.text ("Note: " <> show note))
+ ghc92/HLint/Plugin.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module provides a GHC plugin that you can use to run HLint on a+-- module+--+-- To do so, add this @hlint-plugin@ package as a build dependency of your+-- Haskell package and then add the GHC options @-fplugin HLint.Plugin@+-- To use this plugin, add this package as a build dependency and then enable+-- the following GHC options (typically in the @ghc-options:@ field of your+-- @.cabal@ file):+--+-- > -fplugin HLint.Plugin+--+-- You can pass command-line options to @hlint@ using @-fplugin-opt@, like+-- this:+--+-- > -fplugin HLint.Plugin -fplugin-opt='HLint.Plugin:--ignore=Redundant guard'+module HLint.Plugin+ ( -- * Plugin+ plugin+ ) where++import GHC.Driver.Flags (WarnReason(..))+import GHC.Hs (HsParsedModule(..))+import GHC.Plugins (Plugin(..))+import GHC.Types.Error (DecoratedSDoc, MsgEnvelope(..))+import Language.Haskell.HLint (Idea(..))++import qualified GHC.Data.Bag as Bag+import qualified GHC.Driver.Errors as Errors+import qualified GHC.Plugins as Plugins+import qualified GHC.Types.Error as Error+import qualified GHC.Utils.Logger as Logger+import qualified GHC.Utils.Outputable as Outputable+import qualified HLint.Plugin.Settings as Settings+import qualified Language.Haskell.HLint as HLint++-- | GHC plugin that runs HLint on a Haskell module after parsing the module+plugin :: Plugin+plugin = Plugins.defaultPlugin+ { parsedResultAction+ , pluginRecompile = Plugins.purePlugin+ }+ where+ parsedResultAction arguments _ hsParsedModule = do+ (_parseFlags, classifies, hint) <- do+ Plugins.liftIO (Settings.argsSettings arguments)++ let HsParsedModule{ hpm_module } = hsParsedModule++ dynFlags <- Plugins.getDynFlags++ logger <- Logger.getLogger++ let moduleEx = HLint.createModuleEx hpm_module++ let ideas = HLint.applyHints classifies hint [moduleEx]++ let msgEnvelopes = map ideaToMsgEnvelope ideas++ let messages = Bag.listToBag msgEnvelopes++ Plugins.liftIO (Errors.printOrThrowWarnings logger dynFlags messages)++ pure hsParsedModule++ideaToMsgEnvelope :: Idea -> MsgEnvelope DecoratedSDoc+ideaToMsgEnvelope Idea{..} = MsgEnvelope{..}+ where+ errMsgDiagnostic =+ Error.mkDecorated [ Plugins.vcat (sdocs0 <> sdocs1 <> sdocs2) ]+ where+ sdocs0 = [ Plugins.text ideaHint ]++ sdocs1 =+ case ideaTo of+ Nothing -> []+ Just "" -> []+ Just to -> [ Plugins.text ("Perhaps: " <> to) ]++ sdocs2 = do+ note <- ideaNote++ pure (Plugins.text ("Note: " <> show note))++ errMsgSpan = ideaSpan++ errMsgContext = Outputable.alwaysQualify++ errMsgSeverity =+ case ideaSeverity of+ HLint.Ignore -> Error.SevDump+ HLint.Suggestion -> Error.SevInfo+ HLint.Warning -> Error.SevWarning+ HLint.Error -> Error.SevError++ errMsgReason = NoReason
+ ghc94/HLint/Plugin.hs view
@@ -0,0 +1,121 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module provides a GHC plugin that you can use to run HLint on a+-- module+--+-- To do so, add this @hlint-plugin@ package as a build dependency of your+-- Haskell package and then add the GHC options @-fplugin HLint.Plugin@+-- To use this plugin, add this package as a build dependency and then enable+-- the following GHC options (typically in the @ghc-options:@ field of your+-- @.cabal@ file):+--+-- > -fplugin HLint.Plugin+--+-- You can pass command-line options to @hlint@ using @-fplugin-opt@, like+-- this:+--+-- > -fplugin HLint.Plugin -fplugin-opt='HLint.Plugin:--ignore=Redundant guard'+module HLint.Plugin+ ( -- * Plugin+ plugin+ ) where++import GHC.Driver.Errors.Types (GhcMessage)+import GHC.Hs (HsParsedModule(..))+import GHC.Plugins (Plugin(..))+import Language.Haskell.HLint (Idea(..))++import GHC.Types.Error+ ( DiagnosticMessage(..)+ , DiagnosticReason(..)+ , MsgEnvelope(..)+ )++import qualified GHC.Data.Bag as Bag+import qualified GHC.Driver.Config.Diagnostic as Diagnostic+import qualified GHC.Driver.Errors as Errors+import qualified GHC.Driver.Errors.Types as Errors.Types+import qualified GHC.Plugins as Plugins+import qualified GHC.Types.Error as Error+import qualified GHC.Utils.Logger as Logger+import qualified GHC.Utils.Outputable as Outputable+import qualified HLint.Plugin.Settings as Settings+import qualified Language.Haskell.HLint as HLint++-- | GHC plugin that runs HLint on a Haskell module after parsing the module+plugin :: Plugin+plugin = Plugins.defaultPlugin+ { parsedResultAction+ , pluginRecompile = Plugins.purePlugin+ }+ where+ parsedResultAction arguments _ parsedResult = do+ (_parseFlags, classifies, hint) <- do+ Plugins.liftIO (Settings.argsSettings arguments)++ dynFlags <- Plugins.getDynFlags++ logger <- Logger.getLogger++ let HsParsedModule{ hpm_module } =+ Plugins.parsedResultModule parsedResult++ let moduleEx = HLint.createModuleEx hpm_module++ let ideas = HLint.applyHints classifies hint [moduleEx]++ let msgEnvelopes = map ideaToMsgEnvelope ideas++ let messages = Error.mkMessages (Bag.listToBag msgEnvelopes)++ let diagOpts = Diagnostic.initDiagOpts dynFlags++ Plugins.liftIO (Errors.printOrThrowDiagnostics logger diagOpts messages)++ pure parsedResult++ideaToMsgEnvelope :: Idea -> MsgEnvelope GhcMessage+ideaToMsgEnvelope Idea{..} = MsgEnvelope{..}+ where+ sdoc = Plugins.vcat (sdocs0 <> sdocs1 <> sdocs2)+ where+ sdocs0 = [ Plugins.text ideaHint ]++ sdocs1 =+ case ideaTo of+ Nothing -> []+ Just "" -> []+ Just to -> [ Plugins.text ("Perhaps: " <> to) ]++ sdocs2 = do+ note <- ideaNote++ pure (Plugins.text ("Note: " <> show note))++ errMsgSpan = ideaSpan++ errMsgContext = Outputable.alwaysQualify++ diagnosticMessage = DiagnosticMessage{..}+ where+ diagMessage = Error.mkSimpleDecorated sdoc+ diagReason =+ case ideaSeverity of+ HLint.Ignore -> WarningWithoutFlag+ HLint.Suggestion -> WarningWithoutFlag+ HLint.Warning -> WarningWithoutFlag+ HLint.Error -> ErrorWithoutFlag++ diagHints = []++ errMsgDiagnostic =+ Errors.Types.ghcUnknownMessage diagnosticMessage++ errMsgSeverity =+ case ideaSeverity of+ HLint.Ignore -> Error.SevIgnore+ HLint.Suggestion -> Error.SevWarning+ HLint.Warning -> Error.SevWarning+ HLint.Error -> Error.SevError
+ ghc96/HLint/Plugin.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RecordWildCards #-}++-- | This module provides a GHC plugin that you can use to run HLint on a+-- module+--+-- To do so, add this @hlint-plugin@ package as a build dependency of your+-- Haskell package and then add the GHC options @-fplugin HLint.Plugin@+-- To use this plugin, add this package as a build dependency and then enable+-- the following GHC options (typically in the @ghc-options:@ field of your+-- @.cabal@ file):+--+-- > -fplugin HLint.Plugin+--+-- You can pass command-line options to @hlint@ using @-fplugin-opt@, like+-- this:+--+-- > -fplugin HLint.Plugin -fplugin-opt='HLint.Plugin:--ignore=Redundant guard'+module HLint.Plugin+ ( -- * Plugin+ plugin+ ) where++import GHC.Driver.Errors.Types (GhcMessage)+import GHC.Hs (HsParsedModule(..))+import GHC.Plugins (Plugin(..))+import Language.Haskell.HLint (Idea(..))++import GHC.Types.Error+ ( DiagnosticMessage(..)+ , DiagnosticReason(..)+ , MsgEnvelope(..)+ )++import qualified GHC.Data.Bag as Bag+import qualified GHC.Driver.Config.Diagnostic as Diagnostic+import qualified GHC.Driver.Errors as Errors+import qualified GHC.Driver.Errors.Types as Errors.Types+import qualified GHC.Plugins as Plugins+import qualified GHC.Types.Error as Error+import qualified GHC.Utils.Logger as Logger+import qualified GHC.Utils.Outputable as Outputable+import qualified HLint.Plugin.Settings as Settings+import qualified Language.Haskell.HLint as HLint++-- | GHC plugin that runs HLint on a Haskell module after parsing the module+plugin :: Plugin+plugin = Plugins.defaultPlugin+ { parsedResultAction+ , pluginRecompile = Plugins.purePlugin+ }+ where+ parsedResultAction arguments _ parsedResult = do+ (_parseFlags, classifies, hint) <- do+ Plugins.liftIO (Settings.argsSettings arguments)++ dynFlags <- Plugins.getDynFlags++ logger <- Logger.getLogger++ let HsParsedModule{ hpm_module } =+ Plugins.parsedResultModule parsedResult++ let moduleEx = HLint.createModuleEx hpm_module++ let ideas = HLint.applyHints classifies hint [moduleEx]++ let msgEnvelopes = map ideaToMsgEnvelope ideas++ let messages = Error.mkMessages (Bag.listToBag msgEnvelopes)++ let diagOpts = Diagnostic.initDiagOpts dynFlags++ let ghcMessageOpts = Diagnostic.initPrintConfig dynFlags++ Plugins.liftIO (Errors.printOrThrowDiagnostics logger ghcMessageOpts diagOpts messages)++ pure parsedResult++ideaToMsgEnvelope :: Idea -> MsgEnvelope GhcMessage+ideaToMsgEnvelope Idea{..} = MsgEnvelope{..}+ where+ sdoc = Plugins.vcat (sdocs0 <> sdocs1 <> sdocs2)+ where+ sdocs0 = [ Plugins.text ideaHint ]++ sdocs1 =+ case ideaTo of+ Nothing -> []+ Just "" -> []+ Just to -> [ Plugins.text ("Perhaps: " <> to) ]++ sdocs2 = do+ note <- ideaNote++ pure (Plugins.text ("Note: " <> show note))++ errMsgSpan = ideaSpan++ errMsgContext = Outputable.alwaysQualify++ diagnosticMessage = DiagnosticMessage{..}+ where+ diagMessage = Error.mkSimpleDecorated sdoc+ diagReason =+ case ideaSeverity of+ HLint.Ignore -> WarningWithoutFlag+ HLint.Suggestion -> WarningWithoutFlag+ HLint.Warning -> WarningWithoutFlag+ HLint.Error -> ErrorWithoutFlag++ diagHints = []++ errMsgDiagnostic =+ Errors.Types.ghcUnknownMessage diagnosticMessage++ errMsgSeverity =+ case ideaSeverity of+ HLint.Ignore -> Error.SevIgnore+ HLint.Suggestion -> Error.SevWarning+ HLint.Warning -> Error.SevWarning+ HLint.Error -> Error.SevError
+ hlint-plugin.cabal view
@@ -0,0 +1,43 @@+cabal-version: 3.0+name: hlint-plugin+version: 1.0.0+synopsis: GHC plugin for hlint+description: This package provides an GHC plugin that runs `hlint` on the+ compiled module. The main advantages of doing this are:+ .+ * Better integration with GHC tooling+ * You only have to lint modules that you rebuild+ * You don't have to parse the module twice+license: BSD-3-Clause+license-file: LICENSE+author: Mercury Technologies+maintainer: gabriella@mercury.com+copyright: 2023 Mercury Technologies+build-type: Simple+extra-doc-files: CHANGELOG.md++library+ hs-source-dirs: src+ build-depends: base >=4.15.0.0 && < 5+ , containers+ exposed-modules: HLint.Plugin+ , HLint.Plugin.Settings+ default-language: Haskell2010+ ghc-options: -Wall++ if impl(ghc >= 9.0 && < 9.2)+ hs-source-dirs: ghc90+ build-depends: hlint >= 3.3 && < 3.4+ , ghc >= 9.0.2 && < 9.2+ if impl(ghc >= 9.2 && < 9.4)+ hs-source-dirs: ghc92+ build-depends: hlint >= 3.4 && < 3.5+ , ghc >= 9.2.1 && < 9.4+ if impl(ghc >= 9.4 && < 9.6)+ hs-source-dirs: ghc94+ build-depends: hlint >= 3.5 && < 3.6+ , ghc >= 9.4.1 && < 9.6+ if impl(ghc >= 9.6 && < 9.8)+ hs-source-dirs: ghc96+ build-depends: hlint >= 3.6 && < 3.7+ , ghc >= 9.6.1 && < 9.8
+ src/HLint/Plugin/Settings.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE BlockArguments #-}++-- | This module is inspired by:+--+-- https://github.com/tfausak/splint/blob/9028a8b631568dc5d16a74153b1a9b6e3cde0fe6/src/lib/Splint/Settings.hs+--+-- … in order to work around this issue (just like @splint@ does):+--+-- <https://gitlab.haskell.org/ghc/ghc/issues/18261>+--+-- Without this workaround the GHC plugin will fail with something like this+-- error message:+--+-- > ghc-9.6.2(82937,0x16e83b000) malloc: *** error for object 0x600000a4d5c0: pointer being freed was not allocated+-- > ghc-9.6.2(82937,0x16e83b000) malloc: *** set a breakpoint in malloc_error_break to debug++module HLint.Plugin.Settings+ ( -- * Settings+ argsSettings+ ) where++import Control.Concurrent.MVar (MVar)+import Data.IORef (IORef)+import Data.Map (Map)+import Language.Haskell.HLint (Classify, Hint, ParseFlags)++import qualified Control.Concurrent.MVar as MVar+import qualified Data.IORef as IORef+import qualified Data.Map as Map+import qualified Language.Haskell.HLint as HLint+import qualified System.IO.Unsafe as Unsafe++cache :: IORef (Map [String] (IO (ParseFlags, [Classify], Hint)))+cache = Unsafe.unsafePerformIO (IORef.newIORef Map.empty)+{-# NOINLINE cache #-}++semaphore :: MVar ()+semaphore = Unsafe.unsafePerformIO (MVar.newMVar ())+{-# NOINLINE semaphore #-}++-- | This is a drop-in replacement for+-- "Language.Haskell.HLint".`HLint.argsSettings`, except that this is safe to+-- run in parallel.+argsSettings+ :: [String]+ -> IO (ParseFlags, [Classify], Hint)+argsSettings key = do+ io <- IORef.atomicModifyIORef' cache \m -> do+ case Map.lookup key m of+ Nothing -> do+ let io =+ Unsafe.unsafeInterleaveIO do+ MVar.withMVar semaphore \_ -> HLint.argsSettings key++ (Map.insert key io m, io)++ Just io ->+ (m, io)++ io