Data.Maybe: add callstack for fromJust (Trac #15559)
authorFangyi Zhou <fangyi.zhou@yuriko.moe>
Thu, 1 Nov 2018 22:21:23 +0000 (18:21 -0400)
committerBen Gamari <ben@smart-cactus.org>
Thu, 1 Nov 2018 22:36:08 +0000 (18:36 -0400)
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

libraries/base/Data/Maybe.hs
libraries/base/tests/fromJust.hs [new file with mode: 0644]
libraries/base/tests/fromJust.stderr [new file with mode: 0644]
testsuite/tests/ghci/scripts/ghci023.stdout
testsuite/tests/ghci/scripts/ghci025.stdout
testsuite/tests/ghci/scripts/ghci026.stdout

index d41ae92..2a3e0ef 100644 (file)
@@ -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 (file)
index 0000000..2da524f
--- /dev/null
@@ -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 (file)
index 0000000..9b3a638
--- /dev/null
@@ -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
index 334b67d..9403102 100644 (file)
@@ -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
index e5638b0..75933a9 100644 (file)
@@ -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
index 9fb2790..24049ee 100644 (file)
@@ -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