module Cont(Cont(..),conts, tryM, cmdContF, cmdContK, cmdContK', waitForSP, waitForK, waitForF, waitForFu, cmdContSP,tryGet,getLeftSP,getRightSP,fContWrap,kContWrap,dropSP,contMap) where
--import Direction
import Fudget
import Message(stripHigh, stripLow, aLow) --Message(..),
import Path(here)
--import SP
import Spops
import StreamProcIO
import EitherUtils(stripLeft,stripRight)

cmdContSP :: a -> (b -> Maybe c) -> Cont (SP b a) c
cmdContSP :: forall a b c. a -> (b -> Maybe c) -> Cont (SP b a) c
cmdContSP a
cmd b -> Maybe c
expected c -> SP b a
process =
    forall b a. [b] -> SP a b -> SP a b
putsSP [a
cmd] (forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP b -> Maybe c
expected c -> SP b a
process)

waitForSP :: (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP a -> Maybe t
expected t -> SP a b
process =
    let contSP :: [a] -> SP a b
contSP [a]
pending =
            forall a b. Cont (SP a b) a
getSP (\a
msg ->
                   case a -> Maybe t
expected a
msg of
                     Just t
answer -> forall a b. [a] -> SP a b -> SP a b
startupSP (forall a. [a] -> [a]
reverse [a]
pending) (t -> SP a b
process t
answer)
                     Maybe t
Nothing -> [a] -> SP a b
contSP (a
msg forall a. a -> [a] -> [a]
: [a]
pending))
    in  [a] -> SP a b
contSP []

waitForK :: (KEvent hi -> Maybe a) -> Cont (K hi ho) a
waitForK KEvent hi -> Maybe a
expected = forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap (forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP KEvent hi -> Maybe a
expected)

waitForF :: (a -> Maybe b) -> Cont (F a c) b
waitForF :: forall a b c. (a -> Maybe b) -> Cont (F a c) b
waitForF a -> Maybe b
expected = forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap (forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP forall {a1}. Message a1 a -> Maybe b
expectHigh)
  where expectHigh :: Message a1 a -> Maybe b
expectHigh Message a1 a
msg = forall {a1} {a2}. Message a1 a2 -> Maybe a2
stripHigh Message a1 a
msg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe b
expected

waitForFu :: (KEvent hi -> Maybe ans) -> Cont (F hi ho) ans
waitForFu :: forall hi ans ho. (KEvent hi -> Maybe ans) -> Cont (F hi ho) ans
waitForFu KEvent hi -> Maybe ans
expected = forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap (forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP forall {a}. Message (a, FResponse) hi -> Maybe ans
expectk)
  where expectk :: Message (a, FResponse) hi -> Maybe ans
expectk = KEvent hi -> Maybe ans
expected forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {a} {b}. (t -> a) -> Message t b -> Message a b
aLow forall a b. (a, b) -> b
snd

getLeftSP :: (t -> SP (Either t b) b) -> SP (Either t b) b
getLeftSP = forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP forall {a} {b}. Either a b -> Maybe a
stripLeft
getRightSP :: (t -> SP (Either a1 t) b) -> SP (Either a1 t) b
getRightSP = forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP forall {a1} {a2}. Either a1 a2 -> Maybe a2
stripRight

waitForLow :: (a -> Maybe t) -> (t -> SP (Message a b) b) -> SP (Message a b) b
waitForLow a -> Maybe t
expected = forall {a} {t} {b}. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP forall {b}. Message a b -> Maybe t
expectLow
  where expectLow :: Message a b -> Maybe t
expectLow Message a b
msg = forall {a} {b}. Message a b -> Maybe a
stripLow Message a b
msg forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> Maybe t
expected

cmdContLow :: a
-> (a -> Maybe t)
-> (t -> SP (Message a b) (Message a b))
-> SP (Message a b) (Message a b)
cmdContLow a
cmd a -> Maybe t
expected = forall b a. b -> SP a b -> SP a b
putSP (forall a b. a -> Message a b
Low a
cmd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {t} {b} {b}.
(a -> Maybe t) -> (t -> SP (Message a b) b) -> SP (Message a b) b
waitForLow a -> Maybe t
expected

{- old:
cmdContLow cmd exp' =
    cmdContSP (Low cmd)
              (\msg ->
               case msg of
                 Low ev -> exp' ev
                 _ -> Nothing)
-}

cmdContK :: FRequest -> (FResponse -> Maybe a) -> Cont (K b c) a
cmdContK :: forall a b c. FRequest -> (FResponse -> Maybe a) -> Cont (K b c) a
cmdContK FRequest
xcmd FResponse -> Maybe a
expected = forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap (forall {a} {a} {t} {b} {b}.
a
-> (a -> Maybe t)
-> (t -> SP (Message a b) (Message a b))
-> SP (Message a b) (Message a b)
cmdContLow FRequest
xcmd FResponse -> Maybe a
expected)

cmdContK' :: KCommand ho -> (KEvent hi -> Maybe a) -> Cont (K hi ho) a
cmdContK' KCommand ho
msg KEvent hi -> Maybe a
expected = forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap (forall a b c. a -> (b -> Maybe c) -> Cont (SP b a) c
cmdContSP KCommand ho
msg KEvent hi -> Maybe a
expected)

cmdContF :: FRequest -> (FResponse -> Maybe a) -> Cont (F b c) a
cmdContF :: forall a b c. FRequest -> (FResponse -> Maybe a) -> Cont (F b c) a
cmdContF FRequest
cmd FResponse -> Maybe a
exp' =
    forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap forall a b. (a -> b) -> a -> b
$
    forall {a} {a} {t} {b} {b}.
a
-> (a -> Maybe t)
-> (t -> SP (Message a b) (Message a b))
-> SP (Message a b) (Message a b)
cmdContLow (Path
here, FRequest
cmd)
               (\TEvent
tev ->
                case TEvent
tev of
                  (Path
t, FResponse
ev) | Path
t forall a. Eq a => a -> a -> Bool
== Path
here -> FResponse -> Maybe a
exp' FResponse
ev
                  TEvent
_ -> forall a. Maybe a
Nothing)

conts :: (a -> Cont c b) -> [a] -> Cont c [b]
conts :: forall a c b. (a -> Cont c b) -> [a] -> Cont c [b]
conts a -> Cont c b
g [a]
sl [b] -> c
c =
    let co :: [b] -> [a] -> c
co [b]
al [] = [b] -> c
c (forall a. [a] -> [a]
reverse [b]
al)
        co [b]
al (a
s : [a]
sl') = a -> Cont c b
g a
s (\b
a -> [b] -> [a] -> c
co (b
a forall a. a -> [a] -> [a]
: [b]
al) [a]
sl')
    in  [b] -> [a] -> c
co [] [a]
sl

tryM :: Cont c (Maybe a) -> c -> Cont c a
tryM :: forall c a. Cont c (Maybe a) -> c -> Cont c a
tryM Cont c (Maybe a)
e c
errc a -> c
c = Cont c (Maybe a)
e forall a b. (a -> b) -> a -> b
$ \Maybe a
ov ->
                case Maybe a
ov of
		   Maybe a
Nothing -> c
errc
		   Just a
v -> a -> c
c a
v

tryGet :: Cont c (Maybe a) -> (Cont c a) -> Cont c a
tryGet :: forall c a. Cont c (Maybe a) -> Cont c a -> Cont c a
tryGet Cont c (Maybe a)
e Cont c a
errc a -> c
c = forall c a. Cont c (Maybe a) -> c -> Cont c a
tryM Cont c (Maybe a)
e (Cont c a
errc a -> c
c) a -> c
c

dropSP :: (t -> Maybe t) -> (t -> SP t b) -> SP t b
dropSP t -> Maybe t
expected t -> SP t b
c = SP t b
dropit where
    dropit :: SP t b
dropit =
      forall a b. Cont (SP a b) a
getSP forall a b. (a -> b) -> a -> b
$ \t
msg ->
      case t -> Maybe t
expected t
msg of
	Just t
m -> t -> SP t b
c t
m
	Maybe t
Nothing -> SP t b
dropit

contMap :: (i -> (o -> sp i o) -> sp i o) -> sp i o
contMap i -> (o -> sp i o) -> sp i o
op = sp i o
m
  where m :: sp i o
m = forall (sp :: * -> * -> *) i o.
StreamProcIO sp =>
(i -> sp i o) -> sp i o
get forall a b. (a -> b) -> a -> b
$ \ i
x -> i -> (o -> sp i o) -> sp i o
op i
x forall a b. (a -> b) -> a -> b
$ \ o
y -> forall (sp :: * -> * -> *) o i.
StreamProcIO sp =>
o -> sp i o -> sp i o
put o
y forall a b. (a -> b) -> a -> b
$ sp i o
m
-- or:  where m = get $ flip op $ flip put m


fContWrap :: Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap :: forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap Cont (FSP hi ho) a
waitsp = forall hi ho. FSP hi ho -> F hi ho
F{-ff-} forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont (FSP hi ho) a
waitsp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {hi} {ho}. (t -> F hi ho) -> t -> FSP hi ho
fContSP
  where fContSP :: (t -> F hi ho) -> t -> FSP hi ho
fContSP t -> F hi ho
contF t
x = case t -> F hi ho
contF t
x of F FSP hi ho
sp -> FSP hi ho
sp

kContWrap :: Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap :: forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap Cont (KSP hi ho) a
waitsp = forall hi ho. KSP hi ho -> K hi ho
K{-kk-} forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont (KSP hi ho) a
waitsp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {hi} {ho}. (t -> K hi ho) -> t -> KSP hi ho
kContSP
  where kContSP :: (t -> K hi ho) -> t -> KSP hi ho
kContSP t -> K hi ho
contK t
x = case t -> K hi ho
contK t
x of K KSP hi ho
sp -> KSP hi ho
sp