[ replying to private mail, but cc'ing to the list ]
George Russell asks if he can write a function that traps ^C, with type:
> allowInterrupts :: IO a -> IO a -> IO a
You can implement this as follows: the signal handler needs to send an
exception to the original thread to tell it the signal was caught, and the
original thread then runs the user handler.
Unfortunately... this doesn't work in 4.04 due to a couple of bugs/missing
features: signals don't interrupt threads blocked on I/O, and raising
exceptions in threads blocked on I/O also doesn't work. Patches for both of
these are attached. After applying the patches, this code works for me:
main = allowInterrupts
(getLine >> putStr "Ok.")
-- or (threadDelay 5000000 >> putStr "Ok.")
(putStr "Interrupted.")
handler :: ThreadId -> IO ()
handler parent = raiseInThread parent (ErrorCall "interrupted")
allowInterrupts :: IO a -> IO a -> IO a
allowInterrupts action on_interrupt
= do tso <- myThreadId
(do
old <- installHandler sigINT (Catch (handler tso)) Nothing
res <- action
installHandler sigINT old Nothing
return res
) `catchAllIO`
( \ e -> case e of
ErrorCall "interrupted" -> on_interrupt
_other -> throw e)
Cheers,
Simon
begin 600 patch
M*BHJ(%-C:&5D=6QE+F,@(#$Y.3DO,#DO,3`@,3$Z,3$Z-3$@("`@(#$N,C4*
M+2TM(%-C:&5D=6QE+F,@(#$Y.3DO,3`O,#0@,38Z,#4Z-#8**BHJ*BHJ*BHJ
M*BHJ*BHJ"BHJ*B`W,S(L-S0R("HJ*BH*("`@("`@("!B87)F*")U;F)L;V-K
M5&AR96%D("A"3$%#2TA/3$4I.B!44T\@;F]T(&9O=6YD(BD["B`@("`@('T*
M("`*("`@(&-A<V4@0FQO8VME9$]N4F5A9#H*("`@(&-A<V4@0FQO8VME9$]N
M5W)I=&4Z"B$@("!C87-E($)L;V-K961/;D1E;&%Y.@HA("`@("`O*B!4;T1O
M("HO"B$@("`@(&)A<F8H(G5N8FQO8VM4:')E860@>W)E860L=W)I=&4L9&5L
M87E](BD["B`@"B`@("!D969A=6QT.@H@("`@("!B87)F*")U;F)L;V-K5&AR
M96%D(BD["BTM+2`W,S(L-S4T("TM+2T*("`@("`@("!B87)F*")U;F)L;V-K
M5&AR96%D("A"3$%#2TA/3$4I.B!44T\@;F]T(&9O=6YD(BD["B`@("`@('T*
M("`**R`@(&-A<V4@0FQO8VME9$]N1&5L87DZ"B`@("!C87-E($)L;V-K961/
M;E)E860Z"B`@("!C87-E($)L;V-K961/;E=R:71E.@HA("`@("!["B$@("`@
M("`@;&%S="`]("9B;&]C:V5D7W%U975E7VAD.PHA("`@("`@(&9O<B`H="`]
M(&)L;V-K961?<75E=65?:&0[('0@(3T@14Y$7U133U]1545513L@"B$@("`@
M("`@("`@;&%S="`]("9T+3YL:6YK+"!T(#T@="T^;&EN:RD@>PHA("`@("`@
M(&EF("AT(#T]('1S;RD@>PHA("`@("`@("`@*FQA<W0@/2!T<V\M/FQI;FL[
M"B$@("`@("`@("!I9B`H8FQO8VME9%]Q=65U95]T;"`]/2!T*2!["B$@("`@
M("`@("`@(&)L;V-K961?<75E=65?=&P@/2!T<V\M/FQI;FL["B$@("`@("`@
M("!]"B$@("`@("`@("!G;W1O(&1O;F4["B$@("`@("`@?0HA("`@("`@('T*
M(2`@("`@("!B87)F*")U;F)L;V-K5&AR96%D("A)+T\I.B!44T\@;F]T(&9O
M=6YD(BD["B$@("`@('T*("`*("`@(&1E9F%U;'0Z"B`@("`@(&)A<F8H(G5N
M8FQO8VM4:')E860B*3L**BHJ(%-E;&5C="YC("`@(#$Y.3DO,#DO,3,@,#@Z
M,C@Z-#4@("`@(#$N,@HM+2T@4V5L96-T+F,@("`@,3DY.2\Q,"\P-"`Q-CHP
M-3HT-@HJ*BHJ*BHJ*BHJ*BHJ*BH**BHJ(#$U+#(P("HJ*BH*+2TM(#$U+#(Q
M("TM+2T*("`C:6YC;'5D92`B4G1S571I;',N:"(*("`C:6YC;'5D92`B4G1S
M1FQA9W,N:"(*("`C:6YC;'5D92`B271I;65R+F@B"BL@(VEN8VQU9&4@(E-I
M9VYA;',N:"(*("`*("`C(&EF(&1E9FEN960H2$%615]365-?5%E015-?2"D*
M("`C("!I;F-L=61E(#QS>7,O='EP97,N:#X**BHJ*BHJ*BHJ*BHJ*BHJ"BHJ
M*B`Q,3,L,3$X("HJ*BH*+2TM(#$Q-"PQ,C@@+2TM+0H@("`@("`@("\J(&9F
M;'5S:"AS=&1O=70I.R`J+PH@("`@("`@(&9P<FEN=&8H<W1D97)R+"`B87=A
M:71%=F5N=#H@<V5L96-T(&9A:6QE9%QN(BD["B`@("`@("`@<W1G7V5X:70H
M15A)5%]&04E,55)%*3L**R`@("`@("!]"BL@("`@("`@+RH@5V4@9V]T(&$@
M<VEG;F%L.R!C;W5L9"!B92!O;F4@;V8@;W5R<RX@($EF('-O+"!W92!N965D
M"BL@("`@("`@("H@=&\@<W1A<G0@=7`@=&AE('-I9VYA;"!H86YD;&5R('-T
M<F%I9VAT(&%W87DL(&]T:&5R=VES90HK("`@("`@("`J('=E(&-O=6QD(&)L
M;V-K(&9O<B!A(&QO;F<@=&EM92!B969O<F4@=&AE('-I9VYA;"!I<PHK("`@
M("`@("`J('-E<G9I8V5D+@HK("`@("`@("`J+PHK("`@("`@(&EF("AS:6=N
M86QS7W!E;F1I;F<H*2D@>PHK("`@("`@('-T87)T7W-I9VYA;%]H86YD;&5R
J<[EMAIL PROTECTED]("`@("`@(')E='5R;CL*("`@("`@("!]"B`@("`@('T*("`*
`
end
