Add a Lint hadrian rule and an .hlint.yaml file in base/

6 files changed, 76 insertions, 5 deletions

diff --git a/hadrian/hadrian.cabal b/hadrian/hadrian.cabal
index 11f34a26ba..018068aaf3 100644
--- a/hadrian/hadrian.cabal
+++ b/hadrian/hadrian.cabal
@@ -73,15 +73,16 @@ executable hadrian
                        , Rules.Gmp
                        , Rules.Libffi
                        , Rules.Library
+                       , Rules.Lint
                        , Rules.Nofib
                        , Rules.Program
                        , Rules.Register
                        , Rules.Rts
-                       , Rules.ToolArgs
                        , Rules.Selftest
                        , Rules.SimpleTargets
                        , Rules.SourceDist
                        , Rules.Test
+                       , Rules.ToolArgs
                        , Settings
                        , Settings.Builders.Alex
                        , Settings.Builders.Cabal
@@ -132,15 +133,15 @@ executable hadrian
                        , TupleSections
     other-extensions:    MultiParamTypeClasses
                        , TypeFamilies
-    build-depends:       base                 >= 4.8     && < 5
-                       , Cabal                >= 3.0     && < 3.3
+    build-depends:       Cabal                >= 3.0     && < 3.3
+                       , QuickCheck           >= 2.6     && < 2.14
+                       , base                 >= 4.8     && < 5
                        , containers           >= 0.5     && < 0.7
                        , directory            >= 1.3.1.0 && < 1.4
                        , extra                >= 1.4.7
                        , filepath
                        , mtl                  == 2.2.*
                        , parsec               >= 3.1     && < 3.2
-                       , QuickCheck           >= 2.6     && < 2.14
                        , shake                >= 0.18.3  && < 0.18.6
                        , transformers         >= 0.4     && < 0.6
                        , unordered-containers >= 0.2.1   && < 0.3
diff --git a/hadrian/src/Hadrian/Utilities.hs b/hadrian/src/Hadrian/Utilities.hs
index 4768780d37..8bcfa6f974 100644
--- a/hadrian/src/Hadrian/Utilities.hs
+++ b/hadrian/src/Hadrian/Utilities.hs
@@ -24,6 +24,7 @@ module Hadrian.Utilities (
     Colour (..), ANSIColour (..), putColoured, shouldUseColor,
     BuildProgressColour, mkBuildProgressColour, putBuild,
     SuccessColour, mkSuccessColour, putSuccess,
+    FailureColour, mkFailureColour, putFailure,
     ProgressInfo (..), putProgressInfo,
     renderAction, renderActionNoOutput, renderProgram, renderLibrary, renderBox, renderUnicorn,
 
@@ -470,6 +471,23 @@ putSuccess msg = do
     SuccessColour code <- userSetting green
     putColoured code msg
 
+newtype FailureColour = FailureColour String
+    deriving Typeable
+
+-- | Generate an encoded colour for failure output messages
+mkFailureColour :: Colour -> FailureColour
+mkFailureColour c = FailureColour $ mkColour c
+
+-- | Default 'FailureColour'.
+red :: FailureColour
+red = mkFailureColour (Dull Red)
+
+-- | Print a failure message (e.g. a precondition was not met).
+putFailure :: String -> Action ()
+putFailure msg = do
+  FailureColour code <- userSetting red
+  putColoured code msg
+
 data ProgressInfo = None | Brief | Normal | Unicorn deriving (Eq, Show, Typeable)
 
 -- | Version of 'putBuild' controlled by @--progress-info@ command line argument.
diff --git a/hadrian/src/Main.hs b/hadrian/src/Main.hs
index bc04c707d8..e6bf015c0a 100644
--- a/hadrian/src/Main.hs
+++ b/hadrian/src/Main.hs
@@ -11,6 +11,7 @@ import qualified CommandLine
 import qualified Environment
 import qualified Rules
 import qualified Rules.Clean
+import qualified Rules.Lint
 import qualified Rules.Documentation
 import qualified Rules.Nofib
 import qualified Rules.SourceDist
@@ -84,6 +85,7 @@ main = do
             Rules.buildRules
             Rules.Documentation.documentationRules
             Rules.Clean.cleanRules
+            Rules.Lint.lintRules
             Rules.Nofib.nofibRules
             Rules.oracleRules
             Rules.Selftest.selftestRules
diff --git a/hadrian/src/Rules/Lint.hs b/hadrian/src/Rules/Lint.hs
new file mode 100644
index 0000000000..bbecc08c31
--- /dev/null
+++ b/hadrian/src/Rules/Lint.hs
@@ -0,0 +1,45 @@
+module Rules.Lint
+  ( lintRules
+  ) where
+
+import Base
+import Settings.Builders.Common
+import System.Directory (findExecutable)
+
+lintRules :: Rules ()
+lintRules = "lint" ~> lint
+
+lint :: Action ()
+lint = do
+  isHlintPresent <- isJust <$> (liftIO $ findExecutable "hlint")
+  if isHlintPresent
+  then do
+    putBuild "| Running the linter…"
+    lintBase
+    putSuccess "| Done."
+  else
+    putFailure "| Please make sure you have the `hlint` executable in your $PATH"
+
+lintBase :: Action ()
+lintBase = do
+  topDir   <- topDirectory
+  buildDir <- buildRoot
+  let stage1Lib    = topDir </> buildDir </> "stage1/lib"
+  let machDeps     = topDir </> "includes/MachDeps.h"
+  let hsBaseConfig = topDir </> buildDir </> "stage1/libraries/base/build/include/HsBaseConfig.h"
+  let ghcautoconf  = stage1Lib </> "ghcautoconf.h"
+  let ghcplatform  = stage1Lib </> "ghcplatform.h"
+  need [ghcautoconf, ghcplatform, machDeps, hsBaseConfig]
+  let include0  = topDir </> "includes"
+  let include1  = topDir </> "libraries/base/include"
+  let include2  = stage1Lib
+  let include3  = topDir </> buildDir </> "stage1/libraries/base/build/include"
+  let hlintYaml = topDir </> "libraries/base/.hlint.yaml"
+  hostArch <- (<> "_HOST_ARCH") <$> setting HostArch
+  let cmdLine = "hlint -j --cpp-define " <> hostArch <> " --cpp-include=" <> include0 <>
+                " --cpp-include=" <> include1 <>
+                " --cpp-include=" <> include2 <>
+                " --cpp-include=" <> include3 <>
+                " -h " <> hlintYaml <> " libraries/base"
+  putBuild $ "| " <> cmdLine
+  cmd_ cmdLine
diff --git a/libraries/base/.hlint.yaml b/libraries/base/.hlint.yaml
new file mode 100644
index 0000000000..f596a4a30b
--- /dev/null
+++ b/libraries/base/.hlint.yaml
@@ -0,0 +1,5 @@
+# HLint configuration file
+# https://github.com/ndmitchell/hlint
+##########################
+
+- ignore: {}
diff --git a/libraries/base/Unsafe/Coerce.hs b/libraries/base/Unsafe/Coerce.hs
index 23710c5963..9cd9ef8896 100644
--- a/libraries/base/Unsafe/Coerce.hs
+++ b/libraries/base/Unsafe/Coerce.hs
@@ -308,4 +308,4 @@ unsafeCoerce# = error "GHC internal error: unsafeCoerce# not unfolded"
 
 -- unsafeCoerce version of the amap/coerce rule defined in GHC.Arr
 "amap/unsafeCoerce" amap unsafeCoerce = unsafeCoerce
-#-}
+ #-}