module FudgetIO where
import Fudget
import EitherUtils(Cont(..))
import Message(stripLow,stripHigh)

{-
The purpose of the FudgetIO class is to allow the many IO operations that
can be performed from both fudgets and fudget kernels, e.g., createGC,
loadQueryFont and allocNamedColor, to use one overloaded name instead of
two separate names.
-}

class FudgetIO f where
  waitForMsg :: (KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
  putMsg :: KCommand ho -> f hi ho -> f hi ho

  -- Less useful methods:
  --nullMsg :: f hi ho -- name ?!
  --getMsg :: (KEvent hi -> f hi ho) -> f hi ho

putMsgs :: t (KCommand ho) -> f hi ho -> f hi ho
putMsgs t (KCommand ho)
msgs f hi ho
k = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
KCommand ho -> f hi ho -> f hi ho
putMsg f hi ho
k t (KCommand ho)
msgs
putHigh :: ho -> f hi ho -> f hi ho
putHigh ho
x = (forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
KCommand ho -> f hi ho -> f hi ho
putMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Message a b
High) ho
x
putLow :: FRequest -> f hi ho -> f hi ho
putLow FRequest
x = (forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
KCommand ho -> f hi ho -> f hi ho
putMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Message a b
Low) FRequest
x
putLows :: t FRequest -> f hi ho -> f hi ho
putLows t FRequest
lows f hi ho
k = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {f :: * -> * -> *} {hi} {ho}.
FudgetIO f =>
FRequest -> f hi ho -> f hi ho
putLow f hi ho
k t FRequest
lows

getHigh :: (ans -> f ans ho) -> f ans ho
getHigh ans -> f ans ho
x = forall (f :: * -> * -> *) hi ans ho.
FudgetIO f =>
(KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
waitForMsg forall {a1} {a2}. Message a1 a2 -> Maybe a2
stripHigh ans -> f ans ho
x
getLow :: (FResponse -> f hi ho) -> f hi ho
getLow FResponse -> f hi ho
x = forall (f :: * -> * -> *) hi ans ho.
FudgetIO f =>
(KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
waitForMsg forall {a} {b}. Message a b -> Maybe a
stripLow FResponse -> f hi ho
x

cmdContMsg :: KCommand ho
-> (KEvent hi -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
cmdContMsg KCommand ho
msg KEvent hi -> Maybe ans
expected = forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
KCommand ho -> f hi ho -> f hi ho
putMsg KCommand ho
msg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> * -> *) hi ans ho.
FudgetIO f =>
(KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
waitForMsg KEvent hi -> Maybe ans
expected

cmdContLow :: FRequest -> (FResponse -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
cmdContLow FRequest
cmd FResponse -> Maybe ans
expected = forall {f :: * -> * -> *} {ho} {hi} {ans}.
FudgetIO f =>
KCommand ho
-> (KEvent hi -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
cmdContMsg (forall a b. a -> Message a b
Low FRequest
cmd) forall {b}. Message FResponse b -> Maybe ans
expectLow
  where expectLow :: Message FResponse b -> Maybe ans
expectLow Message FResponse b
msg = forall {a} {b}. Message a b -> Maybe a
stripLow Message FResponse b
msg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FResponse -> Maybe ans
expected