module DynSpacerF(dynSpacerF,dynPlacerF) where
import Fudget
import LayoutRequest
import SerCompF(idLeftF)
import CompSP(postMapSP)
import Path(here)
import Message
--import Command
import FRequest

dynSpacerF :: F c ho -> F (Either Spacer c) ho
dynSpacerF = forall {t} {c} {ho}.
(t -> LayoutMessage) -> F c ho -> F (Either t c) ho
dynLayoutMsgF Spacer -> LayoutMessage
LayoutReplaceSpacer
dynPlacerF :: F c ho -> F (Either Placer c) ho
dynPlacerF = forall {t} {c} {ho}.
(t -> LayoutMessage) -> F c ho -> F (Either t c) ho
dynLayoutMsgF Placer -> LayoutMessage
LayoutReplacePlacer

dynLayoutMsgF :: (t -> LayoutMessage) -> F c ho -> F (Either t c) ho
dynLayoutMsgF t -> LayoutMessage
lmsg F c ho
fud = forall hi ho. FSP hi ho -> F hi ho
F (forall {b}.
Message (Path, FRequest) (Either t b) -> Message (Path, FRequest) b
post forall {t} {b} {a}. (t -> b) -> SP a t -> SP a b
`postMapSP` forall {b}. FSP (Either b c) (Either b ho)
fudsp)
  where
    F FSP (Either b c) (Either b ho)
fudsp = forall {c} {d} {b}. F c d -> F (Either b c) (Either b d)
idLeftF F c ho
fud
    post :: Message (Path, FRequest) (Either t b) -> Message (Path, FRequest) b
post = forall {t1} {t2} {t3}.
(t1 -> t2) -> (t3 -> t2) -> Message t1 t3 -> t2
message forall a b. a -> Message a b
Low (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {b}. t -> Message (Path, FRequest) b
sendLmsg forall a b. b -> Message a b
High)
    sendLmsg :: t -> Message (Path, FRequest) b
sendLmsg t
x = forall a b. a -> Message a b
Low (Path
here,LayoutMessage -> FRequest
LCmd (t -> LayoutMessage
lmsg t
x))