Initial commit

.gitignore

@@ -0,0 +1,2 @@
+/.stack-work/
+/stack.yaml.lock

LICENSE.markdown

@@ -0,0 +1,13 @@
+Copyright 2020 Taylor Fausak
+
+Permission to use, copy, modify, and/or distribute this software for any
+purpose with or without fee is hereby granted, provided that the above
+copyright notice and this permission notice appear in all copies.
+
+THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES WITH
+REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT,
+INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
+LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR
+OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
+PERFORMANCE OF THIS SOFTWARE.

splint.cabal

@@ -0,0 +1,26 @@
+name: splint
+version: 0.0.0.0
+
+build-type: Simple
+cabal-version: >= 1.10
+category: Development
+description: Splint is HLint as a GHC source plugin.
+license-file: LICENSE.markdown
+license: ISC
+maintainer: Taylor Fausak
+synopsis: HLint as a GHC source plugin.
+
+library
+  build-depends:
+    base >= 4.14.0 && < 4.15
+    , ghc >= 8.10.1 && < 8.11
+    , hlint >= 3.1.1 && < 3.2
+  default-language: Haskell2010
+  exposed-modules: Splint
+  ghc-options:
+    -Weverything
+    -Wno-implicit-prelude
+    -Wno-missing-safe-haskell-mode
+    -Wno-prepositive-qualified-module
+    -Wno-unsafe
+  hs-source-dirs: src/lib

src/lib/Splint.hs

@@ -0,0 +1,49 @@
+module Splint ( plugin ) where
+
+import qualified Bag as GHC
+import qualified ErrUtils as GHC
+import qualified GhcPlugins as GHC
+import qualified Language.Haskell.HLint as HLint
+
+plugin :: GHC.Plugin
+plugin = GHC.defaultPlugin
+  { GHC.parsedResultAction = action
+  , GHC.pluginRecompile = GHC.purePlugin
+  }
+
+action
+  :: [GHC.CommandLineOption]
+  -> GHC.ModSummary
+  -> GHC.HsParsedModule
+  -> GHC.Hsc GHC.HsParsedModule
+action _ _ hsParsedModule = do
+  dynFlags <- GHC.getDynFlags
+  GHC.liftIO $ do
+    (_parseFlags, classifies, hint) <- HLint.autoSettings
+    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
+  pure hsParsedModule
+
+ideaToWarnMsg :: GHC.DynFlags -> HLint.Idea -> GHC.WarnMsg
+ideaToWarnMsg dynFlags idea =
+  let
+    mkErrMsg = case HLint.ideaSeverity idea of
+      HLint.Error -> GHC.mkPlainErrMsg
+      _ -> GHC.mkPlainWarnMsg
+    srcSpan = HLint.ideaSpan idea
+    msgDoc = ideaToMsgDoc idea
+  in mkErrMsg dynFlags srcSpan msgDoc
+
+ideaToMsgDoc :: HLint.Idea -> GHC.MsgDoc
+ideaToMsgDoc idea = GHC.vcat
+  [ GHC.text $ show (HLint.ideaSeverity idea) <> ": " <> HLint.ideaHint idea
+  , maybe GHC.empty (GHC.text . mappend "Why not: ") $ HLint.ideaTo idea
+  , GHC.vcat . fmap (GHC.text . mappend "Note: " . show) $ HLint.ideaNote idea
+  ]

stack.yaml

@@ -0,0 +1,6 @@
+snapshot: lts-15.13
+compiler: ghc-8.10.1
+extra-deps:
+  - extra-1.7.1
+  - ghc-lib-parser-ex-8.10.0.10
+  - hlint-3.1.1