[commit: ghc] ghc-8.2: Add `-fmax-errors` flag (6e4c238)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : ghc-8.2
Link       : http://ghc.haskell.org/trac/ghc/changeset/6e4c238274bdd2aea38f833ef32ac028843468c6/ghc

>---------------------------------------------------------------

commit 6e4c238274bdd2aea38f833ef32ac028843468c6
Author: Charles Cooper <cooper.charles.m at gmail.com>
Date:   Mon Mar 13 15:17:58 2017 -0400

    Add `-fmax-errors` flag
    
    This commit adds a command line option to limit the number of errors
    displayed. It also moves the documentation for `reverse-errors` into the
    `Warnings` section.
    
    https://ghc.haskell.org/trac/ghc/ticket/13326
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    Differential Revision: https://phabricator.haskell.org/D3323
    
    (cherry picked from commit 70274b4f8003fde0fa3e4094a10dfae880579786)


>---------------------------------------------------------------

6e4c238274bdd2aea38f833ef32ac028843468c6
 compiler/main/DynFlags.hs                 | 12 ++++++++++--
 compiler/main/ErrUtils.hs                 |  6 +++++-
 utils/mkUserGuidePart/Options/Misc.hs     |  7 -------
 utils/mkUserGuidePart/Options/Warnings.hs | 13 +++++++++++++
 4 files changed, 28 insertions(+), 10 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index e96bf69..e95796d 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -935,7 +935,10 @@ data DynFlags = DynFlags {
   maxInlineMemsetInsns  :: Int,
 
   -- | Reverse the order of error messages in GHC/GHCi
-  reverseErrors :: Bool,
+  reverseErrors         :: Bool,
+
+  -- | Limit the maximum number of errors to show
+  maxErrors             :: Maybe Int,
 
   -- | Unique supply configuration for testing build determinism
   initialUnique         :: Int,
@@ -1684,7 +1687,8 @@ defaultDynFlags mySettings =
         initialUnique = 0,
         uniqueIncrement = 1,
 
-        reverseErrors = False
+        reverseErrors = False,
+        maxErrors     = Nothing
       }
 
 defaultWays :: Settings -> [Way]
@@ -2798,6 +2802,10 @@ dynamic_flags_deps = [
              "Use -fno-force-recomp instead"
   , make_dep_flag defGhcFlag "no-recomp"
         (NoArg $ setGeneralFlag Opt_ForceRecomp) "Use -fforce-recomp instead"
+  , make_ord_flag defFlag "fmax-errors"
+      (intSuffix (\n d -> d { maxErrors = Just (max 1 n) }))
+  , make_ord_flag defFlag "fno-max-errors"
+      (noArg (\d -> d { maxErrors = Nothing }))
   , make_ord_flag defFlag "freverse-errors"
         (noArg (\d -> d {reverseErrors = True} ))
   , make_ord_flag defFlag "fno-reverse-errors"
diff --git a/compiler/main/ErrUtils.hs b/compiler/main/ErrUtils.hs
index d73628a..8e71847 100644
--- a/compiler/main/ErrUtils.hs
+++ b/compiler/main/ErrUtils.hs
@@ -378,11 +378,15 @@ pprLocErrMsg (ErrMsg { errMsgSpan      = s
     mkLocMessage sev s (formatErrDoc dflags doc)
 
 sortMsgBag :: Maybe DynFlags -> Bag ErrMsg -> [ErrMsg]
-sortMsgBag dflags = sortBy (maybeFlip $ comparing errMsgSpan) . bagToList
+sortMsgBag dflags = maybeLimit . sortBy (maybeFlip cmp) . bagToList
   where maybeFlip :: (a -> a -> b) -> (a -> a -> b)
         maybeFlip
           | fromMaybe False (fmap reverseErrors dflags) = flip
           | otherwise                                   = id
+        cmp = comparing errMsgSpan
+        maybeLimit = case join (fmap maxErrors dflags) of
+          Nothing        -> id
+          Just err_limit -> take err_limit
 
 ghcExit :: DynFlags -> Int -> IO ()
 ghcExit dflags val
diff --git a/utils/mkUserGuidePart/Options/Misc.hs b/utils/mkUserGuidePart/Options/Misc.hs
index 57e8808..c542fa3 100644
--- a/utils/mkUserGuidePart/Options/Misc.hs
+++ b/utils/mkUserGuidePart/Options/Misc.hs
@@ -29,13 +29,6 @@ miscOptions =
            "the main thread, rather than a forked thread."
          , flagType = DynamicFlag
          }
-  , flag { flagName = "-freverse-errors"
-         , flagDescription =
-           "Display errors in GHC/GHCi sorted by reverse order of "++
-           "source code line numbers."
-         , flagType = DynamicFlag
-         , flagReverse = "-fno-reverse-errors"
-         }
   , flag { flagName = "-flocal-ghci-history"
          , flagDescription =
            "Use current directory for the GHCi command history "++
diff --git a/utils/mkUserGuidePart/Options/Warnings.hs b/utils/mkUserGuidePart/Options/Warnings.hs
index f242fb0..48ee32c 100644
--- a/utils/mkUserGuidePart/Options/Warnings.hs
+++ b/utils/mkUserGuidePart/Options/Warnings.hs
@@ -90,6 +90,19 @@ warningsOptions =
          , flagType = DynamicFlag
          , flagReverse = "-fno-helpful-errors"
          }
+  , flag { flagName = "-freverse-errors"
+         , flagDescription =
+           "Display errors in GHC/GHCi sorted by reverse order of "++
+           "source code line numbers."
+         , flagType = DynamicFlag
+         , flagReverse = "-fno-reverse-errors"
+         }
+  , flag { flagName = "-fmax-errors"
+         , flagDescription =
+           "Limit the number of errors displayed in GHC/GHCi."
+         , flagType = DynamicFlag
+         , flagReverse = "-fno-max-errors"
+         }
   , flag { flagName = "-Wdeprecated-flags"
          , flagDescription =
            "warn about uses of commandline flags that are deprecated"