[commit: ghc] master: Data.Maybe: add callstack for fromJust (Trac #15559) (614028e)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/614028e3b02a5b71a9fbf9c7028f270760ccdab2/ghc

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

commit 614028e3b02a5b71a9fbf9c7028f270760ccdab2
Author: Fangyi Zhou <fangyi.zhou at yuriko.moe>
Date:   Thu Nov 1 18:21:23 2018 -0400

    Data.Maybe: add callstack for fromJust (Trac #15559)
    
    Per feature request, add `HasCallStack` to `fromJust` in `Data.Maybe`
    and use `error` instead of `errorWithoutStackTrace`. This allows
    `fromJust` to print call stacks when throwing the error.
    
    Also add a new test case for the behaviour, modify existing test cases
    for new signature
    
    Test Plan: New test cases
    
    Reviewers: hvr, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: ulysses4ever, rwbarton, carter
    
    GHC Trac Issues: #15559
    
    Differential Revision: https://phabricator.haskell.org/D5256


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

614028e3b02a5b71a9fbf9c7028f270760ccdab2
 libraries/base/Data/Maybe.hs                |  5 +++--
 libraries/base/tests/fromJust.hs            | 10 ++++++++++
 libraries/base/tests/fromJust.stderr        |  4 ++++
 testsuite/tests/ghci/scripts/ghci023.stdout |  2 +-
 testsuite/tests/ghci/scripts/ghci025.stdout |  2 +-
 testsuite/tests/ghci/scripts/ghci026.stdout |  2 +-
 6 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/libraries/base/Data/Maybe.hs b/libraries/base/Data/Maybe.hs
index d41ae92..2a3e0ef 100644
--- a/libraries/base/Data/Maybe.hs
+++ b/libraries/base/Data/Maybe.hs
@@ -32,6 +32,7 @@ module Data.Maybe
    ) where
 
 import GHC.Base
+import GHC.Stack.Types ( HasCallStack )
 
 -- $setup
 -- Allow the use of some Prelude functions in doctests.
@@ -143,8 +144,8 @@ isNothing _       = False
 -- >>> 2 * (fromJust Nothing)
 -- *** Exception: Maybe.fromJust: Nothing
 --
-fromJust          :: Maybe a -> a
-fromJust Nothing  = errorWithoutStackTrace "Maybe.fromJust: Nothing" -- yuck
+fromJust          :: HasCallStack => Maybe a -> a
+fromJust Nothing  = error "Maybe.fromJust: Nothing" -- yuck
 fromJust (Just x) = x
 
 -- | The 'fromMaybe' function takes a default value and and 'Maybe'
diff --git a/libraries/base/tests/fromJust.hs b/libraries/base/tests/fromJust.hs
new file mode 100644
index 0000000..2da524f
--- /dev/null
+++ b/libraries/base/tests/fromJust.hs
@@ -0,0 +1,10 @@
+module Main where
+
+-- Trac #15559: Add HasCallStack to fromJust
+
+import Data.Maybe ( fromJust )
+
+main :: IO ()
+main = do
+  _ <- fromJust Nothing `seq` return ()
+  putStrLn "Should see a stacktrace instead of this"
diff --git a/libraries/base/tests/fromJust.stderr b/libraries/base/tests/fromJust.stderr
new file mode 100644
index 0000000..9b3a638
--- /dev/null
+++ b/libraries/base/tests/fromJust.stderr
@@ -0,0 +1,4 @@
+fromJust.hs: Maybe.fromJust: Nothing
+CallStack (from HasCallStack):
+  error, called at libraries/base/Data/Maybe.hs:148:21 in base:Data.Maybe
+  fromJust, called at fromJust.hs:9:8 in main:Main
diff --git a/testsuite/tests/ghci/scripts/ghci023.stdout b/testsuite/tests/ghci/scripts/ghci023.stdout
index 334b67d..9403102 100644
--- a/testsuite/tests/ghci/scripts/ghci023.stdout
+++ b/testsuite/tests/ghci/scripts/ghci023.stdout
@@ -4,7 +4,7 @@
 -- layout rule instead of explicit braces and semicolons works too
 (1,2,3)
 Data.Maybe.catMaybes :: [Maybe a] -> [a]
-Data.Maybe.fromJust :: Maybe a -> a
+Data.Maybe.fromJust :: GHC.Stack.Types.HasCallStack => Maybe a -> a
 Data.Maybe.fromMaybe :: a -> Maybe a -> a
 Data.Maybe.isJust :: Maybe a -> Bool
 Data.Maybe.isNothing :: Maybe a -> Bool
diff --git a/testsuite/tests/ghci/scripts/ghci025.stdout b/testsuite/tests/ghci/scripts/ghci025.stdout
index e5638b0..75933a9 100644
--- a/testsuite/tests/ghci/scripts/ghci025.stdout
+++ b/testsuite/tests/ghci/scripts/ghci025.stdout
@@ -25,7 +25,7 @@ class GHC.Base.Applicative m => Monad (m :: * -> *)
   ...
 -- imported via Data.Maybe
 catMaybes :: [Maybe a] -> [a]
-fromJust :: Maybe a -> a
+fromJust :: GHC.Stack.Types.HasCallStack => Maybe a -> a
 fromMaybe :: a -> Maybe a -> a
 isJust :: Maybe a -> GHC.Types.Bool
 isNothing :: Maybe a -> GHC.Types.Bool
diff --git a/testsuite/tests/ghci/scripts/ghci026.stdout b/testsuite/tests/ghci/scripts/ghci026.stdout
index 9fb2790..24049ee 100644
--- a/testsuite/tests/ghci/scripts/ghci026.stdout
+++ b/testsuite/tests/ghci/scripts/ghci026.stdout
@@ -1,5 +1,5 @@
 catMaybes :: [Maybe a] -> [a]
-fromJust :: Maybe a -> a
+fromJust :: GHC.Stack.Types.HasCallStack => Maybe a -> a
 fromMaybe :: a -> Maybe a -> a
 isJust :: Maybe a -> Bool
 isNothing :: Maybe a -> Bool