packages feed

splint 1.0.0.1 → 1.0.1.0

raw patch · 5 files changed

+140/−26 lines, 5 filesdep ~basedep ~ghc

Dependency ranges changed: base, ghc

Files

splint.cabal view
@@ -1,5 +1,7 @@+cabal-version: 2.2+ name: splint-version: 1.0.0.1+version: 1.0.1.0  synopsis: HLint as a GHC source plugin. description:@@ -9,7 +11,6 @@   to ignore the "Use @concatMap@" suggestion.  build-type: Simple-cabal-version: >= 1.10 category: Development extra-source-files: README.markdown license-file: LICENSE.markdown@@ -20,17 +21,38 @@   location: https://github.com/tfausak/splint   type: git -library-  build-depends:-    base >= 4.14.0 && < 4.15-    , ghc >= 8.10.1 && < 8.11-    , hlint >= 3.0 && < 3.2+common basics   default-language: Haskell2010-  exposed-modules: Splint   ghc-options:     -Weverything+    -Wno-all-missed-specialisations     -Wno-implicit-prelude-    -Wno-missing-safe-haskell-mode-    -Wno-prepositive-qualified-module+    -Wno-missing-exported-signatures+    -Wno-missing-import-lists+    -Wno-safe     -Wno-unsafe++  if impl(ghc >= 8.8)+    ghc-options:+      -Wno-missing-deriving-strategies++  if impl(ghc >= 8.10)+    ghc-options:+      -Wno-missing-safe-haskell-mode+      -Wno-prepositive-qualified-module++library+  import: basics++  build-depends:+    base >= 4.12.0 && < 4.15+    , ghc >= 8.6.1 && < 8.11+    , hlint >= 3.0 && < 3.2+  exposed-modules: Splint   hs-source-dirs: src/lib+  other-modules: Splint.Parser++  if impl(ghc == 8.10.*)+    other-modules: Splint.Parser.Native+  else+    other-modules: Splint.Parser.Fallback
src/lib/Splint.hs view
@@ -1,10 +1,14 @@-module Splint ( plugin ) where+module Splint+  ( plugin+  )+where  import qualified Bag as GHC import qualified Data.IORef as IORef import qualified ErrUtils as GHC import qualified GhcPlugins as GHC import qualified Language.Haskell.HLint as HLint+import qualified Splint.Parser as Splint import qualified System.IO.Unsafe as Unsafe  plugin :: GHC.Plugin@@ -18,25 +22,22 @@   -> GHC.ModSummary   -> GHC.HsParsedModule   -> GHC.Hsc GHC.HsParsedModule-action commandLineOptions _modSummary hsParsedModule = do+action commandLineOptions modSummary hsParsedModule = do+  (parseFlags, classifies, hint) <- getSettings commandLineOptions+  moduleEx <- Splint.parse parseFlags modSummary hsParsedModule   dynFlags <- GHC.getDynFlags-  GHC.liftIO $ do-    (_parseFlags, classifies, hint) <- getSettings commandLineOptions-    let-      apiAnns = GHC.hpm_annotations hsParsedModule-      hsModule = GHC.hpm_module hsParsedModule-      moduleEx = HLint.createModuleEx apiAnns hsModule-      ideas = HLint.applyHints classifies hint [moduleEx]-    GHC.printOrThrowWarnings dynFlags-      . GHC.listToBag-      . fmap (ideaToWarnMsg dynFlags)-      $ filter ((/= HLint.Ignore) . HLint.ideaSeverity) ideas+  GHC.liftIO+    . GHC.printOrThrowWarnings dynFlags+    . GHC.listToBag+    . fmap (ideaToWarnMsg dynFlags)+    . filter ((/= HLint.Ignore) . HLint.ideaSeverity)+    $ HLint.applyHints classifies hint [moduleEx]   pure hsParsedModule  type Settings = (HLint.ParseFlags, [HLint.Classify], HLint.Hint) -getSettings :: [GHC.CommandLineOption] -> IO Settings-getSettings commandLineOptions = do+getSettings :: [GHC.CommandLineOption] -> GHC.Hsc Settings+getSettings commandLineOptions = GHC.liftIO $ do   maybeSettings <- IORef.readIORef settingsRef   case maybeSettings of     Just settings -> pure settings@@ -55,7 +56,12 @@     mkErrMsg = case HLint.ideaSeverity idea of       HLint.Error -> GHC.mkPlainErrMsg       _ -> GHC.mkPlainWarnMsg-    srcSpan = HLint.ideaSpan idea+    srcSpan = case HLint.unpackSrcSpan $ HLint.ideaSpan idea of+      Nothing -> GHC.noSrcSpan+      Just (file, (startLine, startColumn), (endLine, endColumn)) ->+        GHC.mkSrcSpan+          (GHC.mkSrcLoc (GHC.mkFastString file) startLine startColumn)+          (GHC.mkSrcLoc (GHC.mkFastString file) endLine endColumn)     msgDoc = ideaToMsgDoc idea   in mkErrMsg dynFlags srcSpan msgDoc
+ src/lib/Splint/Parser.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE CPP #-}++-- | Starting with HLint 3, it's possible to re-use the parsed module that GHC+-- produces to avoid re-parsing the module. Unfortunately this is only possible+-- when the GHC version matches the version that HLint expects. Otherwise we+-- have to let HLint re-parse the module to produce it's expected AST.+--+-- This module is responsible for picking that behavior. The so-called "native"+-- behavior is the one where GHC's parse module is re-used. The "fallback"+-- parser is the one that re-parses the module.+--+-- Doing this requires a build-time decision, which means using CPP. Therefore+-- this module is kept as small as possible in order to make it easier to+-- reason about.+--+-- It is expected that both the "native" and "fallback" parsers expose the+-- exact same interface.+--+-- You could in theory always use the "fallback" parser, but that would mean+-- doing a lot of unnecessary work by re-parsing modules. Parsing is typically+-- fast and this is hard to quantify, so if you want to go that route you+-- should consider using Ollie Charles's hlint-source-plugin instead.+-- <https://github.com/ocharles/hlint-source-plugin>+module Splint.Parser+  ( parse+  )+where++#if (__GLASGOW_HASKELL__ == 810)+import Splint.Parser.Native (parse)+#else+import Splint.Parser.Fallback (parse)+#endif
+ src/lib/Splint/Parser/Fallback.hs view
@@ -0,0 +1,35 @@+module Splint.Parser.Fallback+  ( parse+  )+where++import qualified Control.Exception as Exception+import qualified GhcPlugins as GHC+import qualified Language.Haskell.HLint as HLint++parse+  :: HLint.ParseFlags+  -> GHC.ModSummary+  -> GHC.HsParsedModule+  -> GHC.Hsc HLint.ModuleEx+parse parseFlags modSummary _ = GHC.liftIO $ do+  let filePath = GHC.msHsFilePath modSummary+  result <- HLint.parseModuleEx parseFlags filePath Nothing+  case result of+    Left parseError -> Exception.throwIO $ ParseError parseError+    Right moduleEx -> pure moduleEx++newtype ParseError = ParseError HLint.ParseError++instance Exception.Exception ParseError++instance Show ParseError where+  show (ParseError parseError) = mconcat+    [ "ParseError { parseErrorLocation = "+    , show $ HLint.parseErrorLocation parseError+    , ", parseErrorMessage = "+    , show $ HLint.parseErrorMessage parseError+    , ", parseErrorContents = "+    , show $ HLint.parseErrorContents parseError+    , " }"+    ]
+ src/lib/Splint/Parser/Native.hs view
@@ -0,0 +1,18 @@+module Splint.Parser.Native+  ( parse+  )+where++import qualified GhcPlugins as GHC+import qualified Language.Haskell.HLint as HLint++parse+  :: HLint.ParseFlags+  -> GHC.ModSummary+  -> GHC.HsParsedModule+  -> GHC.Hsc HLint.ModuleEx+parse _ _ hsParsedModule = do+  let+    apiAnns = GHC.hpm_annotations hsParsedModule+    hsModule = GHC.hpm_module hsParsedModule+  pure $ HLint.createModuleEx apiAnns hsModule