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 = (Spacer -> LayoutMessage) -> F c ho -> F (Either Spacer c) ho
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 = (Placer -> LayoutMessage) -> F c ho -> F (Either Placer c) ho
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 = FSP (Either t c) ho -> F (Either t c) ho
forall hi ho. FSP hi ho -> F hi ho
F (Message (Path, FRequest) (Either t ho)
-> Message (Path, FRequest) ho
forall b.
Message (Path, FRequest) (Either t b) -> Message (Path, FRequest) b
post (Message (Path, FRequest) (Either t ho)
 -> Message (Path, FRequest) ho)
-> SP
     (FEvent (Either t c)) (Message (Path, FRequest) (Either t ho))
-> FSP (Either t c) ho
forall t b a. (t -> b) -> SP a t -> SP a b
`postMapSP` SP (FEvent (Either t c)) (Message (Path, FRequest) (Either t ho))
forall b. FSP (Either b c) (Either b ho)
fudsp)
  where
    F FSP (Either b c) (Either b ho)
fudsp = F c ho -> F (Either b c) (Either b ho)
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 = ((Path, FRequest) -> Message (Path, FRequest) b)
-> (Either t b -> Message (Path, FRequest) b)
-> Message (Path, FRequest) (Either t b)
-> Message (Path, FRequest) b
forall t1 p t2. (t1 -> p) -> (t2 -> p) -> Message t1 t2 -> p
message (Path, FRequest) -> Message (Path, FRequest) b
forall a b. a -> Message a b
Low ((t -> Message (Path, FRequest) b)
-> (b -> Message (Path, FRequest) b)
-> Either t b
-> Message (Path, FRequest) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either t -> Message (Path, FRequest) b
forall b. t -> Message (Path, FRequest) b
sendLmsg b -> Message (Path, FRequest) b
forall a b. b -> Message a b
High)
    sendLmsg :: t -> Message (Path, FRequest) b
sendLmsg t
x = (Path, FRequest) -> Message (Path, FRequest) b
forall a b. a -> Message a b
Low (Path
here,LayoutMessage -> FRequest
LCmd (t -> LayoutMessage
lmsg t
x))