module SpyF where
import Fudget
import CompOps
import IoF(ioF)
import StdIoUtil(echoStderrK)
--import EitherUtils
import NullF(getK,putK{-,F,K-})
--import FudgetIO
--import ContinuationIO(stderr)

spyF :: F a1 b -> F a1 b
spyF F a1 b
f = forall {b}. (b -> [Char]) -> [Char] -> F b b
teeF forall a. Show a => a -> [Char]
show [Char]
"OUT: " forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==< F a1 b
f forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==< forall {b}. (b -> [Char]) -> [Char] -> F b b
teeF forall a. Show a => a -> [Char]
show [Char]
"IN: "

teeF :: (b -> [Char]) -> [Char] -> F b b
teeF b -> [Char]
show [Char]
prefix = forall {a} {b}. K a b -> F a b
ioF K b b
teeK
  where
    teeK :: K b b
teeK =
      forall {hi} {ho}. Cont (K hi ho) (KEvent hi)
getK forall a b. (a -> b) -> a -> b
$ \KEvent b
msg ->
      case KEvent b
msg of
	Low FResponse
_ -> K b b
teeK
	High b
msg -> forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
[Char] -> f hi ho -> f hi ho
echoStderrK ([Char]
prefixforall a. [a] -> [a] -> [a]
++b -> [Char]
show b
msg) forall a b. (a -> b) -> a -> b
$
		    forall {ho} {hi}. KCommand ho -> K hi ho -> K hi ho
putK (forall a b. b -> Message a b
High b
msg) forall a b. (a -> b) -> a -> b
$
		    K b b
teeK