A question about the Callback
example (with functions h1
and h2
and useDebbugable
). If, instead of doing putStrLn $ "n = " ++ show n ++ " at " ++ prettyCallStack callStack
in g2
, I do
g2 :: HasCallStack => Int -> IO ()
g2 n = do
throwIO (userError "foo")
Then the exception that bubbles up and is printed doesn’t mention g1
or g2
. Shouldn’t it?
HasCallStack backtrace:
collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-3f06:Control.Monad.Catch
throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:381:7 in exceptions-0.10.7-3f06:Control.Monad.Catch
generalBracket, called at src/Debug/Provenance/Scope.hs:44:5 in debuggable-0.1.0-ddebb9d545ffc4eda207d06c6f5bb3e3e629385347299f3f1c960b2508033984:Debug.Provenance.Scope
scoped, called at app/Main.hs:27:8 in deb-0.1.0.0-inplace-deb:Main
h2, called at app/Main.hs:24:8 in deb-0.1.0.0-inplace-deb:Main
h1, called at app/Main.hs:30:17 in deb-0.1.0.0-inplace-deb:Main
useDebuggable, called at app/Main.hs:37:5 in deb-0.1.0.0-inplace-deb:Main
Edit: g1
and g2
are also missing in the withoutDebuggable
case, if I throw the exception and don’t use Callback
:
collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:371:12 in exceptions-0.10.7-3f06:Control.Monad.Catch
throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:381:7 in exceptions-0.10.7-3f06:Control.Monad.Catch
generalBracket, called at src/Debug/Provenance/Scope.hs:44:5 in debuggable-0.1.0-ddebb9d545ffc4eda207d06c6f5bb3e3e629385347299f3f1c960b2508033984:Debug.Provenance.Scope
scoped, called at app/Main.hs:13:8 in deb-0.1.0.0-inplace-deb:Main
f2, called at app/Main.hs:10:8 in deb-0.1.0.0-inplace-deb:Main
f1, called at app/Main.hs:33:21 in deb-0.1.0.0-inplace-deb:Main
withoutDebuggable, called at app/Main.hs:38:5 in deb-0.1.0.0-inplace-deb:Main
So it has to do with how exceptions bubble up and interact with HasCallStack
, not with Callback
.
Edit#2: If I remove the use of “scoped”, g1
and g2
start to appear
f2 :: HasCallStack => (Int -> IO ()) -> IO ()
-- f2 k = scoped $ k 1
f2 k = k 1
h2 :: HasCallStack => Callback IO Int () -> IO ()
-- h2 k = scoped $ invokeCallback k 1
h2 k = invokeCallback k 1
HasCallStack backtrace:
collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
throwIO, called at app/Main.hs:22:5 in deb-0.1.0.0-inplace-deb:Main
g2, called at app/Main.hs:17:8 in deb-0.1.0.0-inplace-deb:Main
g1, called at app/Main.hs:35:24 in deb-0.1.0.0-inplace-deb:Main
withoutDebuggable, called at app/Main.hs:40:5 in deb-0.1.0.0-inplace-deb:Main
Thanks for sharing! There are some really interesting features to be unlocked with HasCallStack
. Here’s one that I’ve just written up: Domain errors with HasCallStack
@adamgundry Very cool! Are there any plans to upstream that into base? I’d imagine you’d like to get some feedback from users first?
@danidiaz well spotted! This is indeed very confusing. I believe this to be a bug in ghc; I was going to open a ticket, but then I realized that it was fixed (at least improved) in 9.12. Consider this minimal example, in 9.10:
module Main (main) where
import Control.Exception
import GHC.Stack
scoped :: IO () -> IO ()
scoped k = bracket (return ()) (\_ -> return ()) (\_ -> k)
f :: HasCallStack => IO ()
f = throwIO (userError $ prettyCallStack callStack)
g :: HasCallStack => (HasCallStack => IO ()) -> IO ()
g k = scoped k
main :: IO ()
main = g f
In 9.10, this prints
issue: user error (CallStack (from HasCallStack):
f, called at demo/Issue.hs:16:10 in debuggable-0.1.0-inplace-issue:Main
k, called at demo/Issue.hs:13:14 in debuggable-0.1.0-inplace-issue:Main
g, called at demo/Issue.hs:16:8 in debuggable-0.1.0-inplace-issue:Main)
HasCallStack backtrace:
collectBacktraces, called at libraries/ghc-internal/src/GHC/Internal/Exception.hs:92:13 in ghc-internal:GHC.Internal.Exception
toExceptionWithBacktrace, called at libraries/ghc-internal/src/GHC/Internal/IO.hs:260:11 in ghc-internal:GHC.Internal.IO
throwIO, called at libraries/ghc-internal/src/GHC/Internal/Control/Exception/Base.hs:195:43 in ghc-internal:GHC.Internal.Control.Exception.Base
Very confusing that the callstack attached to the exception is completely different from the callstack that we capture ourselves! With 9.12, this becomes
user error (CallStack (from HasCallStack):
f, called at demo/Issue.hs:16:10 in debuggable-0.1.0-inplace-issue:Main
k, called at demo/Issue.hs:13:14 in debuggable-0.1.0-inplace-issue:Main
g, called at demo/Issue.hs:16:8 in debuggable-0.1.0-inplace-issue:Main)
HasCallStack backtrace:
throwIO, called at demo/Issue.hs:10:5 in debuggable-0.1.0-inplace-issue:Main
f, called at demo/Issue.hs:16:10 in debuggable-0.1.0-inplace-issue:Main
k, called at demo/Issue.hs:13:14 in debuggable-0.1.0-inplace-issue:Main
g, called at demo/Issue.hs:16:8 in debuggable-0.1.0-inplace-issue:Main
Much better! I believe this is due to the fact that bracket
is losing context in 9.10; this is more clearly visible with 9.12 with the original demo (modified as you describe); there we get
demo: Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException:
user error (n = 1 at CallStack (from HasCallStack):
g2, called at demo/Demo/Callback.hs:38:8 in debuggable-0.1.0-inplace-demo:Demo.Callback
g1, called at demo/Demo/Callback.hs:24:39 in debuggable-0.1.0-inplace-demo:Demo.Callback
callbackFn, called at src/Debug/Provenance/Callback.hs:57:48 in debuggable-0.1.0-inplace:Debug.Provenance.Callback
invoking callback defined at {unknown} (demo/Demo/Callback.hs:24:30), called at demo/Demo/Callback.hs:52:17 in debuggable-0.1.0-inplace-demo:Demo.Callback
h2, called at demo/Demo/Callback.hs:49:8 in debuggable-0.1.0-inplace-demo:Demo.Callback
h1, called at demo/Demo/Callback.hs:24:26 in debuggable-0.1.0-inplace-demo:Demo.Callback)
While handling user error (n = 1 at CallStack (from HasCallStack):
| g2, called at demo/Demo/Callback.hs:38:8 in debuggable-0.1.0-inplace-demo:Demo.Callback
| g1, called at demo/Demo/Callback.hs:24:39 in debuggable-0.1.0-inplace-demo:Demo.Callback
| callbackFn, called at src/Debug/Provenance/Callback.hs:57:48 in debuggable-0.1.0-inplace:Debug.Provenance.Callback
| invoking callback defined at {unknown} (demo/Demo/Callback.hs:24:30), called at demo/Demo/Callback.hs:52:17 in debuggable-0.1.0-inplace-demo:Demo.Callback
| h2, called at demo/Demo/Callback.hs:49:8 in debuggable-0.1.0-inplace-demo:Demo.Callback
| h1, called at demo/Demo/Callback.hs:24:26 in debuggable-0.1.0-inplace-demo:Demo.Callback)
HasCallStack backtrace:
throwIO, called at libraries/exceptions/src/Control/Monad/Catch.hs:308:12 in exceptions-0.10.9-2a27:Control.Monad.Catch
throwM, called at libraries/exceptions/src/Control/Monad/Catch.hs:318:7 in exceptions-0.10.9-2a27:Control.Monad.Catch
generalBracket, called at src/Debug/Provenance/Scope.hs:44:5 in debuggable-0.1.0-inplace:Debug.Provenance.Scope
scoped, called at demo/Demo/Callback.hs:52:8 in debuggable-0.1.0-inplace-demo:Demo.Callback
h2, called at demo/Demo/Callback.hs:49:8 in debuggable-0.1.0-inplace-demo:Demo.Callback
h1, called at demo/Demo/Callback.hs:24:26 in debuggable-0.1.0-inplace-demo:Demo.Callback
In this case, the two different callstacks (one that involves h
and g
) and one that involves generalBracket
are separated out. Not entirely sure why we get the WhileHandling
in this example and not in the simplified one, I didn’t dig further than this.
Currently there are no plans to merge this into base
. Perhaps it could be argued that packages such as debuggable
and recover-rtti
belong in base
; but personally at least I prefer to move to a smaller rather than larger base
.
Sorry I misspoke, I had intended to ask about the thread-safe non-interleaved IO. This is oftentimes something that is pointed at by newcomers as a quick win that was weirdly never addressed in base
's putStrLn.
Ah. Yeah, I’m not sure actually why it works the way that it does. In fact, a Handle
is already an MVar
under the hood, which could be reused for thread safety. It would mean that you cannot define hPutStrLn
in terms of hPutChar
, perhaps that’s considered unclean, I’m not sure. I agree that the interleaved output is rarely (if ever?) what you want.
What are you referring to?
What are you referring to?
Why concurrent calls to putStrLn
and co result in interleaved output.
I’m afraid this is not enough for me to reproduce the issue. The following program seems to work perfectly fine under chmod +x PutStrLn.hs && ./PutStrLn.hs
:
#!/usr/bin/env cabal
{- cabal:
build-depends: base, async
-}
import Control.Concurrent.Async (forConcurrently_)
import Control.Monad (replicateM_)
main :: IO ()
main = forConcurrently_ [1..5] $ \num ->
replicateM_ 5 $ putStrLn $ "Hi, I'm worker #" ++ show num
Of course, you can break it by setting NoBuffering :: BufferMode
, but that would be expected, right?..
This may convince you. N.B.
-
-threaded
seems important - If that still doesn’t reproduce the issue for you, try increasing the argument to
replicate
#!/usr/bin/env cabal
{- cabal:
build-depends: base, async
ghc-options: -threaded
-}
import Control.Concurrent.Async (forConcurrently_)
import Control.Monad (replicateM_)
import Data.Char
main :: IO ()
main = forConcurrently_ [1 .. 5] $ \num ->
putStrLn $ replicate (3 * 1000) (chr (ord 'A' + num))