blob: be8dd630402aa8f7c0d6b9cb95b6e10cf6097adb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
|
{- | Code used by the RTS
-}
module GHC.JS.Prim.Internal ( blockedIndefinitelyOnMVar
, blockedIndefinitelyOnSTM
, wouldBlock
, ignoreException
, setCurrentThreadResultException
, setCurrentThreadResultValue
) where
import Control.Exception
import GHC.JS.Prim
wouldBlock :: SomeException
wouldBlock = toException WouldBlockException
blockedIndefinitelyOnMVar :: SomeException
blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
blockedIndefinitelyOnSTM :: SomeException
blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
ignoreException :: SomeException -> IO ()
ignoreException _ = return ()
setCurrentThreadResultException :: SomeException -> IO ()
setCurrentThreadResultException e
| Just WouldBlockException <- fromException e =
js_setCurrentThreadResultWouldBlock
| Just (JSException v _) <- fromException e =
js_setCurrentThreadResultJSException v
| otherwise =
js_setCurrentThreadResultHaskellException (toJSString (show e))
setCurrentThreadResultValue :: IO JSVal -> IO ()
setCurrentThreadResultValue x = js_setCurrentThreadResultValue =<< x
foreign import javascript unsafe
"(() => { return h$setCurrentThreadResultWouldBlock; })"
js_setCurrentThreadResultWouldBlock :: IO ()
foreign import javascript unsafe
"(($1) => { return h$setCurrentThreadResultJSException($1); })"
js_setCurrentThreadResultJSException :: JSVal -> IO ()
foreign import javascript unsafe
"(($1) => { return h$setCurrentThreadResultHaskellException($1); })"
js_setCurrentThreadResultHaskellException :: JSVal -> IO ()
foreign import javascript unsafe
"(($1) => { return h$setCurrentThreadResultValue($1); })"
js_setCurrentThreadResultValue :: JSVal -> IO ()
|
