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

6 files changed, 20 insertions, 5 deletions

diff --git a/libraries/base/Data/Maybe.hs b/libraries/base/Data/Maybe.hs
index d41ae92672..2a3e0efe7f 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 0000000000..2da524ffed
--- /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 0000000000..9b3a63885f
--- /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 334b67d9fe..9403102dd9 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 e5638b07e9..75933a9196 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 9fb27908e6..24049ee655 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