module NullF(module NullF, Cont(..),K,F,StreamProcIO(..),FudgetIO(..)) where
import Utils(pair)
import Fudget
import Message(aLow,stripHigh) --Message(..),
import Path(here)
import Spops
import Cont(dropSP,kContWrap,fContWrap,waitForK,waitForFu)
import StreamProcIO
import FudgetIO

--{- -}
instance StreamProcIO F where
  put :: o -> F i o -> F i o
put = o -> F i o -> F i o
forall o i. o -> F i o -> F i o
putF
  get :: (i -> F i o) -> F i o
get = (i -> F i o) -> F i o
forall i o. (i -> F i o) -> F i o
getF -- Discards low level input! Leave undefined?
  end :: F i o
end = F i o
forall i o. F i o
nullF

instance StreamProcIO K where
  put :: o -> K i o -> K i o
put = o -> K i o -> K i o
forall (f :: * -> * -> *) ho hi.
FudgetIO f =>
ho -> f hi ho -> f hi ho
putHigh
  get :: (i -> K i o) -> K i o
get = (i -> K i o) -> K i o
forall (f :: * -> * -> *) ans ho.
FudgetIO f =>
(ans -> f ans ho) -> f ans ho
getHigh
  end :: K i o
end = K i o
forall i o. K i o
nullK

instance FudgetIO F where
  waitForMsg :: (KEvent hi -> Maybe ans) -> Cont (F hi ho) ans
waitForMsg = (KEvent hi -> Maybe ans) -> Cont (F hi ho) ans
forall hi ans ho. (KEvent hi -> Maybe ans) -> Cont (F hi ho) ans
waitForFu
  putMsg :: KCommand ho -> F hi ho -> F hi ho
putMsg = KCommand ho -> F hi ho -> F hi ho
forall ho hi. KCommand ho -> F hi ho -> F hi ho
putMessageFu
  --nullMsg = nullF
  --getMsg = getMessageFu


instance FudgetIO K where
  putMsg :: KCommand ho -> K hi ho -> K hi ho
putMsg = KCommand ho -> K hi ho -> K hi ho
forall ho hi. KCommand ho -> K hi ho -> K hi ho
putK
  waitForMsg :: (KEvent hi -> Maybe ans) -> Cont (K hi ho) ans
waitForMsg = (KEvent hi -> Maybe ans) -> Cont (K hi ho) ans
forall hi ans ho. (KEvent hi -> Maybe ans) -> Cont (K hi ho) ans
waitForK
  --nullMsg = nullK
  --getMsg = getK

---}

----

nullK :: K hi ho
nullK = KSP hi ho -> K hi ho
forall hi ho. KSP hi ho -> K hi ho
K{-kk-} KSP hi ho
forall a b. SP a b
nullSP
nullF :: F hi ho
nullF = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} FSP hi ho
forall a b. SP a b
nullSP

--putK :: KCommand ho -> K hi ho -> K hi ho
putK :: KCommand ho -> K hi ho -> K hi ho
putK KCommand ho
o (K KSP hi ho
sp) = KSP hi ho -> K hi ho
forall hi ho. KSP hi ho -> K hi ho
kk (KCommand ho -> KSP hi ho -> KSP hi ho
forall b a. b -> SP a b -> SP a b
putSP KCommand ho
o KSP hi ho
sp)

putF :: ho -> F hi ho -> F hi ho
putF = FCommand ho -> F hi ho -> F hi ho
forall ho hi. FCommand ho -> F hi ho -> F hi ho
putMessageF (FCommand ho -> F hi ho -> F hi ho)
-> (ho -> FCommand ho) -> ho -> F hi ho -> F hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ho -> FCommand ho
forall a b. b -> Message a b
High

putsF :: [b] -> F a b -> F a b
putsF = forall b a. [b] -> F a b -> F a b
forall (t :: * -> *) (sp :: * -> * -> *) o i.
(Foldable t, StreamProcIO sp) =>
t o -> sp i o -> sp i o
puts :: ([b] -> F a b -> F a b)
--putsF his f = foldr putF f his
putsK :: [KCommand b] -> K a b -> K a b
putsK = forall b a. [KCommand b] -> K a b -> K a b
forall (t :: * -> *) (f :: * -> * -> *) ho hi.
(Foldable t, FudgetIO f) =>
t (KCommand ho) -> f hi ho -> f hi ho
putMsgs :: ([KCommand b] -> K a b -> K a b)
--putsK msgs k = foldr putK k msgs

putMessageF :: FCommand ho -> F hi ho -> F hi ho
putMessageF FCommand ho
msg (F FSP hi ho
sp) = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} (FCommand ho -> FSP hi ho -> FSP hi ho
forall b a. b -> SP a b -> SP a b
putSP FCommand ho
msg FSP hi ho
sp)
putMessageFu :: Message FRequest ho -> F hi ho -> F hi ho
putMessageFu = FCommand ho -> F hi ho -> F hi ho
forall ho hi. FCommand ho -> F hi ho -> F hi ho
putMessageF (FCommand ho -> F hi ho -> F hi ho)
-> (Message FRequest ho -> FCommand ho)
-> Message FRequest ho
-> F hi ho
-> F hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FRequest -> (Path, FRequest))
-> Message FRequest ho -> FCommand ho
forall t a b. (t -> a) -> Message t b -> Message a b
aLow (Path -> FRequest -> (Path, FRequest)
forall a b. a -> b -> (a, b)
pair Path
here)

putMessagesF :: [FCommand ho] -> F hi ho -> F hi ho
putMessagesF [FCommand ho]
hos (F FSP hi ho
sp) = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} ([FCommand ho] -> FSP hi ho -> FSP hi ho
forall b a. [b] -> SP a b -> SP a b
putsSP [FCommand ho]
hos FSP hi ho
sp)
putMessagesFu :: [KCommand b] -> F a b -> F a b
putMessagesFu = forall b a. [KCommand b] -> F a b -> F a b
forall (t :: * -> *) (f :: * -> * -> *) ho hi.
(Foldable t, FudgetIO f) =>
t (KCommand ho) -> f hi ho -> f hi ho
putMsgs :: ([KCommand b] -> F a b -> F a b)
--putMessagesFu msgs f = foldr putMessageFu f msgs

--appendStartK :: [KCommand b] -> K a b -> K a b
appendStartK :: [KCommand ho] -> K hi ho -> K hi ho
appendStartK [KCommand ho]
kcmds (K KSP hi ho
sp) = KSP hi ho -> K hi ho
forall hi ho. KSP hi ho -> K hi ho
kk ([KCommand ho] -> KSP hi ho -> KSP hi ho
forall b a. [b] -> SP a b -> SP a b
appendStartSP [KCommand ho]
kcmds KSP hi ho
sp)

--appendStartMessageF :: [FCommand b] -> F a b -> F a b
appendStartMessageF :: [FCommand ho] -> F hi ho -> F hi ho
appendStartMessageF [FCommand ho]
fcmds (F FSP hi ho
sp) = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} ([FCommand ho] -> FSP hi ho -> FSP hi ho
forall b a. [b] -> SP a b -> SP a b
appendStartSP [FCommand ho]
fcmds FSP hi ho
sp)

--appendStartF :: [b] -> F a b -> F a b
appendStartF :: [ho] -> F hi ho -> F hi ho
appendStartF = [FCommand ho] -> F hi ho -> F hi ho
forall ho hi. [FCommand ho] -> F hi ho -> F hi ho
appendStartMessageF ([FCommand ho] -> F hi ho -> F hi ho)
-> ([ho] -> [FCommand ho]) -> [ho] -> F hi ho -> F hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ho -> FCommand ho) -> [ho] -> [FCommand ho]
forall a b. (a -> b) -> [a] -> [b]
map ho -> FCommand ho
forall a b. b -> Message a b
High

getK :: Cont (K hi ho) (KEvent hi)
getK = Cont (KSP hi ho) (KEvent hi) -> Cont (K hi ho) (KEvent hi)
forall hi ho a. Cont (KSP hi ho) a -> Cont (K hi ho) a
kContWrap Cont (KSP hi ho) (KEvent hi)
forall a b. Cont (SP a b) a
getSP -- :: (Cont (K a b) (KEvent a))

getMessageF :: Cont (F hi ho) (FEvent hi)
getMessageF = Cont (FSP hi ho) (FEvent hi) -> Cont (F hi ho) (FEvent hi)
forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap Cont (FSP hi ho) (FEvent hi)
forall a b. Cont (SP a b) a
getSP -- :: (Cont (F a b) (FEvent a))
getMessageFu :: Cont (F a b) (KEvent a)
getMessageFu = Cont (FSP a b) (Message FResponse a)
-> Cont (F a b) (Message FResponse a)
forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap (Cont (FSP a b) (Message (Path, FResponse) a)
forall a b. Cont (SP a b) a
getSP Cont (FSP a b) (Message (Path, FResponse) a)
-> ((Message FResponse a -> FSP a b)
    -> Message (Path, FResponse) a -> FSP a b)
-> Cont (FSP a b) (Message FResponse a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Message FResponse a -> FSP a b)
-> (Message (Path, FResponse) a -> Message FResponse a)
-> Message (Path, FResponse) a
-> FSP a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Path, FResponse) -> FResponse)
-> Message (Path, FResponse) a -> Message FResponse a
forall t a b. (t -> a) -> Message t b -> Message a b
aLow (Path, FResponse) -> FResponse
forall a b. (a, b) -> b
snd)) :: (Cont (F a b) (KEvent a))

--getF :: Cont (F a b) a
getF :: Cont (F a ho) a
getF = Cont (FSP a ho) a -> Cont (F a ho) a
forall hi ho a. Cont (FSP hi ho) a -> Cont (F hi ho) a
fContWrap ((Message (Path, FResponse) a -> Maybe a) -> Cont (FSP a ho) a
forall t1 t2 b. (t1 -> Maybe t2) -> (t2 -> SP t1 b) -> SP t1 b
dropSP Message (Path, FResponse) a -> Maybe a
forall a1 a2. Message a1 a2 -> Maybe a2
stripHigh)

--startupK :: ([KEvent a] -> K a b -> K a b)
startupK :: [KEvent hi] -> K hi ho -> K hi ho
startupK [KEvent hi]
kevs (K KSP hi ho
sp) = KSP hi ho -> K hi ho
forall hi ho. KSP hi ho -> K hi ho
kk ([KEvent hi] -> KSP hi ho -> KSP hi ho
forall a b. [a] -> SP a b -> SP a b
startupSP [KEvent hi]
kevs KSP hi ho
sp)
--startupMessageF :: ([FEvent a] -> F a b -> F a b)
startupMessageF :: [FEvent hi] -> F hi ho -> F hi ho
startupMessageF [FEvent hi]
fevs (F FSP hi ho
sp) = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} ([FEvent hi] -> FSP hi ho -> FSP hi ho
forall a b. [a] -> SP a b -> SP a b
startupSP [FEvent hi]
fevs FSP hi ho
sp)

--startupMessageFu = startupMessageF . map (aLow (pair here)) -- error prone

--startupF :: [a] -> F a b -> F a b
startupF :: [hi] -> F hi ho -> F hi ho
startupF = [FEvent hi] -> F hi ho -> F hi ho
forall hi ho. [FEvent hi] -> F hi ho -> F hi ho
startupMessageF ([FEvent hi] -> F hi ho -> F hi ho)
-> ([hi] -> [FEvent hi]) -> [hi] -> F hi ho -> F hi ho
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (hi -> FEvent hi) -> [hi] -> [FEvent hi]
forall a b. (a -> b) -> [a] -> [b]
map hi -> FEvent hi
forall a b. b -> Message a b
High

--delayF :: (F a b -> F a b)
delayF :: F hi ho -> F hi ho
delayF (F FSP hi ho
sp) = FSP hi ho -> F hi ho
forall hi ho. FSP hi ho -> F hi ho
F{-ff-} (FSP hi ho -> FSP hi ho
forall a b. SP a b -> SP a b
delaySP FSP hi ho
sp)