module FudgetIO where
import Fudget
import EitherUtils(Cont(..))
import Message(stripLow,stripHigh)
class FudgetIO f where
waitForMsg :: (KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
putMsg :: KCommand ho -> 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 = (KCommand ho -> f hi ho -> f hi ho)
-> f hi ho -> t (KCommand ho) -> f hi ho
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr KCommand ho -> f hi ho -> f hi ho
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 = (KCommand ho -> f hi ho -> f hi ho
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
KCommand ho -> f hi ho -> f hi ho
putMsg (KCommand ho -> f hi ho -> f hi ho)
-> (ho -> KCommand ho) -> ho -> f hi ho -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ho -> KCommand ho
forall a b. b -> Message a b
High) ho
x
putLow :: FRequest -> f hi ho -> f hi ho
putLow FRequest
x = (KCommand ho -> f hi ho -> f hi ho
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
KCommand ho -> f hi ho -> f hi ho
putMsg (KCommand ho -> f hi ho -> f hi ho)
-> (FRequest -> KCommand ho) -> FRequest -> f hi ho -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FRequest -> KCommand ho
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 = (FRequest -> f hi ho -> f hi ho)
-> f hi ho -> t FRequest -> f hi ho
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FRequest -> f hi ho -> f hi ho
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 = (KEvent ans -> Maybe ans) -> (ans -> f ans ho) -> f ans ho
forall (f :: * -> * -> *) hi ans ho.
FudgetIO f =>
(KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
waitForMsg KEvent ans -> Maybe ans
forall a1 a2. Message a1 a2 -> Maybe a2
stripHigh ans -> f ans ho
x
getLow :: (FResponse -> f b ho) -> f b ho
getLow FResponse -> f b ho
x = (KEvent b -> Maybe FResponse) -> (FResponse -> f b ho) -> f b ho
forall (f :: * -> * -> *) hi ans ho.
FudgetIO f =>
(KEvent hi -> Maybe ans) -> Cont (f hi ho) ans
waitForMsg KEvent b -> Maybe FResponse
forall a b. Message a b -> Maybe a
stripLow FResponse -> f b 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 = KCommand ho -> f hi ho -> f hi ho
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
KCommand ho -> f hi ho -> f hi ho
putMsg KCommand ho
msg (f hi ho -> f hi ho)
-> ((ans -> f hi ho) -> f hi ho) -> (ans -> f hi ho) -> f hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KEvent hi -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
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 b ho) -> f b ho
cmdContLow FRequest
cmd FResponse -> Maybe ans
expected = KCommand ho -> (KEvent b -> Maybe ans) -> (ans -> f b ho) -> f b ho
forall (f :: * -> * -> *) ho hi ans.
FudgetIO f =>
KCommand ho
-> (KEvent hi -> Maybe ans) -> (ans -> f hi ho) -> f hi ho
cmdContMsg (FRequest -> KCommand ho
forall a b. a -> Message a b
Low FRequest
cmd) KEvent b -> Maybe ans
forall b. Message FResponse b -> Maybe ans
expectLow
where expectLow :: Message FResponse b -> Maybe ans
expectLow Message FResponse b
msg = Message FResponse b -> Maybe FResponse
forall a b. Message a b -> Maybe a
stripLow Message FResponse b
msg Maybe FResponse -> (FResponse -> Maybe ans) -> Maybe ans
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FResponse -> Maybe ans
expected