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 = putF
  get = getF -- Discards low level input! Leave undefined?
  end = nullF

instance StreamProcIO K where
  put = putHigh
  get = getHigh
  end = nullK

instance FudgetIO F where
  waitForMsg = waitForFu
  putMsg = putMessageFu
  --nullMsg = nullF
  --getMsg = getMessageFu


instance FudgetIO K where
  putMsg = putK
  waitForMsg = waitForK
  --nullMsg = nullK
  --getMsg = getK

---}

----

nullK = K{-kk-} nullSP
nullF = F{-ff-} nullSP

--putK :: KCommand ho -> K hi ho -> K hi ho
putK o (K sp) = kk (putSP o sp)

putF = putMessageF . High

putsF = puts :: ([b] -> F a b -> F a b)
--putsF his f = foldr putF f his
putsK = putMsgs :: ([KCommand b] -> K a b -> K a b)
--putsK msgs k = foldr putK k msgs

putMessageF msg (F sp) = F{-ff-} (putSP msg sp)
putMessageFu = putMessageF . aLow (pair here)

putMessagesF hos (F sp) = F{-ff-} (putsSP hos sp)
putMessagesFu = 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 kcmds (K sp) = kk (appendStartSP kcmds sp)

--appendStartMessageF :: [FCommand b] -> F a b -> F a b
appendStartMessageF fcmds (F sp) = F{-ff-} (appendStartSP fcmds sp)

--appendStartF :: [b] -> F a b -> F a b
appendStartF = appendStartMessageF . map High

getK = kContWrap getSP -- :: (Cont (K a b) (KEvent a))

getMessageF = fContWrap getSP -- :: (Cont (F a b) (FEvent a))
getMessageFu = fContWrap (getSP . (. aLow snd)) :: (Cont (F a b) (KEvent a))

--getF :: Cont (F a b) a
getF = fContWrap (dropSP stripHigh)

--startupK :: ([KEvent a] -> K a b -> K a b)
startupK kevs (K sp) = kk (startupSP kevs sp)
--startupMessageF :: ([FEvent a] -> F a b -> F a b)
startupMessageF fevs (F sp) = F{-ff-} (startupSP fevs sp)

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

--startupF :: [a] -> F a b -> F a b
startupF = startupMessageF . map High

--delayF :: (F a b -> F a b)
delayF (F sp) = F{-ff-} (delaySP sp)