module BellF where
import NullF(getF,putF)
import Command
import Xcommand

bellF :: F ho ho
bellF = Cont (F ho ho) ho
forall a ho. Cont (F a ho) a
getF Cont (F ho ho) ho -> Cont (F ho ho) ho
forall a b. (a -> b) -> a -> b
$ \ ho
x ->
 	XCommand -> F ho ho -> F ho ho
forall i o. XCommand -> F i o -> F i o
xcommandF (Int -> XCommand
Bell Int
0) (F ho ho -> F ho ho) -> F ho ho -> F ho ho
forall a b. (a -> b) -> a -> b
$
	ho -> F ho ho -> F ho ho
forall ho hi. ho -> F hi ho -> F hi ho
putF ho
x (F ho ho -> F ho ho) -> F ho ho -> F ho ho
forall a b. (a -> b) -> a -> b
$
 	F ho ho
bellF