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 :: a -> (b -> Maybe c) -> Cont (SP b a) c
cmdContSP a
cmd b -> Maybe c
expected c -> SP b a
process =
    [a] -> SP b a -> SP b a
forall b a. [b] -> SP a b -> SP a b
putsSP [a
cmd] ((b -> Maybe c) -> Cont (SP b a) c
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 =
            Cont (SP a b) a
forall a b. Cont (SP a b) a
getSP (\a
msg ->
                   case a -> Maybe t
expected a
msg of
                     Just t
answer -> [a] -> SP a b -> SP a b
forall a b. [a] -> SP a b -> SP a b
startupSP ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
pending) (t -> SP a b
process t
answer)
                     Maybe t
Nothing -> [a] -> SP a b
contSP (a
msg a -> [a] -> [a]
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 = Cont (KSP hi ho) a -> Cont (K hi ho) a
forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap ((KEvent hi -> Maybe a) -> Cont (KSP hi ho) a
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 :: (a -> Maybe b) -> Cont (F a c) b
waitForF a -> Maybe b
expected = Cont (FSP a c) b -> Cont (F a c) b
forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap ((Message TEvent a -> Maybe b) -> Cont (FSP a c) b
forall a t b. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP Message TEvent a -> Maybe b
forall a1. Message a1 a -> Maybe b
expectHigh)
  where expectHigh :: Message a1 a -> Maybe b
expectHigh Message a1 a
msg = Message a1 a -> Maybe a
forall a1 a2. Message a1 a2 -> Maybe a2
stripHigh Message a1 a
msg Maybe a -> (a -> Maybe b) -> Maybe b
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 :: (KEvent hi -> Maybe ans) -> Cont (F hi ho) ans
waitForFu KEvent hi -> Maybe ans
expected = Cont (FSP hi ho) ans -> Cont (F hi ho) ans
forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap ((Message TEvent hi -> Maybe ans) -> Cont (FSP hi ho) ans
forall a t b. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP Message TEvent hi -> Maybe ans
forall a. Message (a, FResponse) hi -> Maybe ans
expectk)
  where expectk :: Message (a, FResponse) hi -> Maybe ans
expectk = KEvent hi -> Maybe ans
expected (KEvent hi -> Maybe ans)
-> (Message (a, FResponse) hi -> KEvent hi)
-> Message (a, FResponse) hi
-> Maybe ans
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, FResponse) -> FResponse)
-> Message (a, FResponse) hi -> KEvent hi
forall t a b. (t -> a) -> Message t b -> Message a b
aLow (a, FResponse) -> FResponse
forall a b. (a, b) -> b
snd

getLeftSP :: (t -> SP (Either t b) b) -> SP (Either t b) b
getLeftSP = (Either t b -> Maybe t)
-> (t -> SP (Either t b) b) -> SP (Either t b) b
forall a t b. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP Either t b -> Maybe t
forall a b. Either a b -> Maybe a
stripLeft
getRightSP :: (t -> SP (Either a1 t) b) -> SP (Either a1 t) b
getRightSP = (Either a1 t -> Maybe t)
-> (t -> SP (Either a1 t) b) -> SP (Either a1 t) b
forall a t b. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP Either a1 t -> Maybe t
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 = (Message a b -> Maybe t)
-> (t -> SP (Message a b) b) -> SP (Message a b) b
forall a t b. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP Message a b -> Maybe t
forall b. Message a b -> Maybe t
expectLow
  where expectLow :: Message a b -> Maybe t
expectLow Message a b
msg = Message a b -> Maybe a
forall a b. Message a b -> Maybe a
stripLow Message a b
msg Maybe a -> (a -> Maybe t) -> Maybe t
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 = Message a b
-> SP (Message a b) (Message a b) -> SP (Message a b) (Message a b)
forall b a. b -> SP a b -> SP a b
putSP (a -> Message a b
forall a b. a -> Message a b
Low a
cmd) (SP (Message a b) (Message a b) -> SP (Message a b) (Message a b))
-> ((t -> SP (Message a b) (Message a b))
    -> SP (Message a b) (Message a b))
-> (t -> SP (Message a b) (Message a b))
-> SP (Message a b) (Message a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Maybe t)
-> (t -> SP (Message a b) (Message a b))
-> SP (Message a b) (Message a b)
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 :: FRequest -> (FResponse -> Maybe a) -> Cont (K b c) a
cmdContK FRequest
xcmd FResponse -> Maybe a
expected = Cont (KSP b c) a -> Cont (K b c) a
forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap (FRequest -> (FResponse -> Maybe a) -> Cont (KSP b c) a
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 = Cont (KSP hi ho) a -> Cont (K hi ho) a
forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap (KCommand ho -> (KEvent hi -> Maybe a) -> Cont (KSP hi ho) a
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 :: FRequest -> (FResponse -> Maybe a) -> Cont (F b c) a
cmdContF FRequest
cmd FResponse -> Maybe a
exp' =
    Cont (FSP b c) a -> Cont (F b c) a
forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap (Cont (FSP b c) a -> Cont (F b c) a)
-> Cont (FSP b c) a -> Cont (F b c) a
forall a b. (a -> b) -> a -> b
$
    (Path, FRequest) -> (TEvent -> Maybe a) -> Cont (FSP b c) a
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 Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
here -> FResponse -> Maybe a
exp' FResponse
ev
                  TEvent
_ -> Maybe a
forall a. Maybe a
Nothing)

conts :: (a -> Cont c b) -> [a] -> Cont c [b]
conts :: (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 ([b] -> [b]
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 b -> [b] -> [b]
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 :: Cont c (Maybe a) -> c -> Cont c a
tryM Cont c (Maybe a)
e c
errc a -> c
c = Cont c (Maybe a)
e Cont c (Maybe a) -> Cont c (Maybe a)
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 :: Cont c (Maybe a) -> Cont c a -> Cont c a
tryGet Cont c (Maybe a)
e Cont c a
errc a -> c
c = Cont c (Maybe a) -> c -> Cont c a
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 =
      Cont (SP t b) t
forall a b. Cont (SP a b) a
getSP Cont (SP t b) t -> Cont (SP t b) t
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 = (i -> sp i o) -> sp i o
forall (sp :: * -> * -> *) i o.
StreamProcIO sp =>
(i -> sp i o) -> sp i o
get ((i -> sp i o) -> sp i o) -> (i -> sp i o) -> sp i o
forall a b. (a -> b) -> a -> b
$ \ i
x -> i -> (o -> sp i o) -> sp i o
op i
x ((o -> sp i o) -> sp i o) -> (o -> sp i o) -> sp i o
forall a b. (a -> b) -> a -> b
$ \ o
y -> o -> sp i o -> sp i o
forall (sp :: * -> * -> *) o i.
StreamProcIO sp =>
o -> sp i o -> sp i o
put o
y (sp i o -> sp i o) -> sp i o -> sp i o
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 :: Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap Cont (FSP hi ho) a
waitsp = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} (FSP hi ho -> F hi ho)
-> ((a -> F hi ho) -> FSP hi ho) -> Cont (F hi ho) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont (FSP hi ho) a
waitsp Cont (FSP hi ho) a
-> ((a -> F hi ho) -> a -> FSP hi ho)
-> (a -> F hi ho)
-> FSP hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> F hi ho) -> a -> FSP hi ho
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 :: Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap Cont (KSP hi ho) a
waitsp = KSP hi ho -> K hi ho
forall hi ho. KSP hi ho -> K hi ho
K{-kk-} (KSP hi ho -> K hi ho)
-> ((a -> K hi ho) -> KSP hi ho) -> Cont (K hi ho) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cont (KSP hi ho) a
waitsp Cont (KSP hi ho) a
-> ((a -> K hi ho) -> a -> KSP hi ho)
-> (a -> K hi ho)
-> KSP hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> K hi ho) -> a -> KSP hi ho
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