module WindowF(adjustBorderWidth,border_width,getBWidth,kernelF, toKernel, kernelTag,autumnize, windowKF) where
import Command
import CompOps((>+<))
import CompSP(prepostMapSP)
import Utils(pair,mapList)
import Direction
import Event
import Fudget
import FRequest
import Geometry(Point(..), Rect(..), origin, padd, pmax, rR)
import LayoutRequest
import LoopLow
import NullF
import Path
import CompFfun(prepostMapLow)
import Spops
import Data.Maybe(fromMaybe,isJust)
import Xtypes
import CmdLineEnv(argFlag)
kernelF :: (K a b) -> F a b
kernelF :: K a b -> F a b
kernelF (K KSP a b
proc) =
let prep :: Message (a, a) b -> Message a b
prep (High b
a) = b -> Message a b
forall a b. b -> Message a b
High b
a
prep (Low (a
_, a
b)) = a -> Message a b
forall a b. a -> Message a b
Low a
b
post :: Message b b -> Message (Path, b) b
post (High b
a) = b -> Message (Path, b) b
forall a b. b -> Message a b
High b
a
post (Low b
b) = (Path, b) -> Message (Path, b) b
forall a b. a -> Message a b
Low (Path
here, b
b)
in FSP a b -> F a b
forall hi ho. FSP hi ho -> F hi ho
ff ((Message (Path, FResponse) a -> Message FResponse a)
-> (Message FRequest b -> Message (Path, FRequest) b)
-> KSP a b
-> FSP a b
forall t1 a t2 b. (t1 -> a) -> (t2 -> b) -> SP a t2 -> SP t1 b
prepostMapSP Message (Path, FResponse) a -> Message FResponse a
forall a a b. Message (a, a) b -> Message a b
prep Message FRequest b -> Message (Path, FRequest) b
forall b b. Message b b -> Message (Path, b) b
post KSP a b
proc)
toLowHere :: [b] -> [Message (Path, b) b]
toLowHere = (b -> Message (Path, b) b) -> [b] -> [Message (Path, b) b]
forall a b. (a -> b) -> [a] -> [b]
mapList ((Path, b) -> Message (Path, b) b
forall a b. a -> Message a b
Low ((Path, b) -> Message (Path, b) b)
-> (b -> (Path, b)) -> b -> Message (Path, b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> b -> (Path, b)
forall a b. a -> b -> (a, b)
pair Path
here)
winF :: (Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
winF :: (Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
winF Rect -> FRequest
winCmd [FRequest]
startcmds Rect
rect K a b
w =
[FCommand b] -> F a b -> F a b
forall ho hi. [FCommand ho] -> F hi ho -> F hi ho
putMessagesF ([FRequest] -> [FCommand b]
forall b b. [b] -> [Message (Path, b) b]
toLowHere (Rect -> FRequest
winCmd Rect
rect FRequest -> [FRequest] -> [FRequest]
forall a. a -> [a] -> [a]
: [FRequest]
startcmds)) (K a b -> F a b
forall a b. K a b -> F a b
kernelF K a b
w)
newKTag :: Bool
newKTag = Bool -> Bool
not ([Char] -> Bool -> Bool
argFlag [Char]
"oldKTag" Bool
True)
kernelTag :: Path
kernelTag = if Bool
newKTag then Path
here else Direction -> Path -> Path
turn Direction
L Path
here
autumnize :: [a] -> [a]
autumnize = if Bool
newKTag then [a] -> [a]
forall a. a -> a
id else [a] -> [a]
forall a. [a] -> [a]
autumnize' where
autumnize' :: [a] -> [a]
autumnize' [] = []
autumnize' [a]
l = ([a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
tail ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse) [a]
l
toKernel :: [b] -> [Message (Path, b) b]
toKernel [b]
x = (b -> Message (Path, b) b) -> [b] -> [Message (Path, b) b]
forall a b. (a -> b) -> [a] -> [b]
mapList ((Path, b) -> Message (Path, b) b
forall a b. a -> Message a b
Low ((Path, b) -> Message (Path, b) b)
-> (b -> (Path, b)) -> b -> Message (Path, b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> b -> (Path, b)
forall a b. a -> b -> (a, b)
pair Path
kernelTag) [b]
x
getBWidth :: [WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws = case [WindowChanges]
cws of
[] -> Maybe Int
forall a. Maybe a
Nothing
CWBorderWidth Int
bw':[WindowChanges]
_ -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
bw'
WindowChanges
_:[WindowChanges]
cws -> [WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws
adjustBorderWidth :: Int -> Point -> Point
adjustBorderWidth Int
b (Point Int
x Int
y) = Int -> Int -> Point
Point (Int
xInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2) (Int
yInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
b2) where b2 :: Int
b2 = Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
b
border_width :: Int
border_width = Int
0::Int
windowKF :: (Rect -> FRequest) -> Bool -> Bool -> [FRequest] -> Maybe Rect -> K a b -> F c d -> F (Either a c) (Either b d)
windowKF :: (Rect -> FRequest)
-> Bool
-> Bool
-> [FRequest]
-> Maybe Rect
-> K a b
-> F c d
-> F (Either a c) (Either b d)
windowKF Rect -> FRequest
winCmd Bool
isShell Bool
nomap [FRequest]
startcmds Maybe Rect
oplace K a b
k F c d
f =
let ctrlSP :: (Int, Bool)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw,Bool
nomap) =
Cont
(SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse)))
(Either (Path, FRequest) (Path, FResponse))
forall a b. Cont (SP a b) a
getSP Cont
(SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse)))
(Either (Path, FRequest) (Path, FResponse))
-> Cont
(SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse)))
(Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$ \Either (Path, FRequest) (Path, FResponse)
msg ->
let same :: SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
same = (Int, Bool)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw,Bool
nomap)
pass :: SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
pass = Either (Path, FRequest) (Path, FResponse)
-> SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP Either (Path, FRequest) (Path, FResponse)
msg
passame :: SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
passame = SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall a.
SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
pass SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
same
adjB :: Int -> Point -> Point
adjB Int
b Point
s = if Bool
isShell then Point
s else Int -> Point -> Point
adjustBorderWidth Int
b Point
s
in case Either (Path, FRequest) (Path, FResponse)
msg of
Left (Path
tag,FRequest
cmd) -> case FRequest
cmd of
XReq (CreateMyWindow Rect
r) | Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
kernelTag ->
Either (Path, FRequest) (Path, FResponse)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left (Path
kernelTag,
XRequest -> FRequest
XReq (Path -> Rect -> XRequest
CreateSimpleWindow Path
tag Rect
r))) SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
same
XCmd (ReparentToMe Path
r Window
w) | Path
r Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
here Bool -> Bool -> Bool
&& Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
/= Path
kernelTag ->
Either (Path, FRequest) (Path, FResponse)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left (Path
kernelTag,XCommand -> FRequest
XCmd (Path -> Window -> XCommand
ReparentToMe Path
tag Window
w))) SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
same
XCmd (ConfigureWindow [WindowChanges]
cws) | Path
tag Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
kernelTag ->
let bw' :: Int
bw' = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
bw ([WindowChanges] -> Maybe Int
getBWidth [WindowChanges]
cws) in
if Int
bw'Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
bw' then SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall a.
SP a (Either (Path, FRequest) (Path, FResponse))
-> SP a (Either (Path, FRequest) (Path, FResponse))
pass (SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse)))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$ (Int, Bool)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw',Bool
nomap) else [Char]
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall a. HasCallStack => [Char] -> a
error [Char]
"windowKF"
LCmd (LayoutRequest LayoutRequest
req) ->
Either (Path, FRequest) (Path, FResponse)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall b a. b -> SP a b -> SP a b
putSP ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left (Path
tag,LayoutRequest -> FRequest
layoutRequestCmd ((Point -> Point) -> LayoutRequest -> LayoutRequest
mapLayoutSize (Int -> Point -> Point
adjB Int
bw) LayoutRequest
req))) (SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse)))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$
SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
same
FRequest
_ -> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
passame
Right (Path
tag,FResponse
evt) -> case FResponse
evt of
XResp (WindowCreated Window
_) | Path
tagPath -> Path -> Bool
forall a. Eq a => a -> a -> Bool
==Path
kernelTag -> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
same
LEvt (LayoutPlace (Rect Point
p Point
s)) -> let ads :: Point
ads = Int -> Point -> Point
adjB (-Int
bw) Point
s in
[Either (Path, FRequest) (Path, FResponse)]
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall b a. [b] -> SP a b -> SP a b
putsSP ([(Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
tag, LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace (Point -> Point -> Rect
Rect Point
origin Point
ads))),
(Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
kernelTag, LayoutResponse -> FResponse
LEvt (Point -> LayoutResponse
LayoutSize Point
ads)),
(Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
kernelTag, LayoutResponse -> FResponse
LEvt (Point -> LayoutResponse
LayoutPos Point
p))] [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
forall a. [a] -> [a] -> [a]
++
(if Bool
isShell then []
else (FRequest -> Either (Path, FRequest) (Path, FResponse))
-> [FRequest] -> [Either (Path, FRequest) (Path, FResponse)]
forall a b. (a -> b) -> [a] -> [b]
mapList ((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse))
-> (FRequest -> (Path, FRequest))
-> FRequest
-> Either (Path, FRequest) (Path, FResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> FRequest -> (Path, FRequest)
forall a b. a -> b -> (a, b)
pair Path
kernelTag)
([XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Rect -> XCommand
moveResizeWindow (Rect -> Rect
checkSize (Point -> Point -> Rect
Rect Point
p Point
ads))] [FRequest] -> [FRequest] -> [FRequest]
forall a. [a] -> [a] -> [a]
++
(if Bool
nomap Bool -> Bool -> Bool
|| Bool
static then []
else [XCommand -> FRequest
XCmd XCommand
MapRaised])))) (SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse)))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$
(Int, Bool)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
bw,Bool
True)
LEvt (LayoutSize Point
s) -> let ads :: Point
ads = Int -> Point -> Point
adjB (-Int
bw) Point
s in
[Either (Path, FRequest) (Path, FResponse)]
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall b a. [b] -> SP a b -> SP a b
putsSP ([(Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
tag, LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace (Point -> Point -> Rect
Rect Point
origin Point
ads))),
(Path, FResponse) -> Either (Path, FRequest) (Path, FResponse)
forall a b. b -> Either a b
Right (Path
kernelTag, LayoutResponse -> FResponse
LEvt (Point -> LayoutResponse
LayoutSize Point
ads))] [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
-> [Either (Path, FRequest) (Path, FResponse)]
forall a. [a] -> [a] -> [a]
++
(if Bool
isShell then []
else [((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse)
forall a b. a -> Either a b
Left((Path, FRequest) -> Either (Path, FRequest) (Path, FResponse))
-> (FRequest -> (Path, FRequest))
-> FRequest
-> Either (Path, FRequest) (Path, FResponse)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> FRequest -> (Path, FRequest)
forall a b. a -> b -> (a, b)
pair Path
kernelTag)
(XCommand -> FRequest
XCmd (XCommand -> FRequest) -> XCommand -> FRequest
forall a b. (a -> b) -> a -> b
$ Point -> XCommand
resizeWindow (Point -> Point -> Point
pmax Point
ads Point
minSize))])) (SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse)))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
forall a b. (a -> b) -> a -> b
$
SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
same
FResponse
_ -> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
passame
minSize :: Point
minSize = Int -> Int -> Point
Point Int
1 Int
1
checkSize :: Rect -> Rect
checkSize (Rect Point
p Point
s) = Point -> Point -> Rect
Rect Point
p (Point -> Point -> Point
pmax Point
s Point
minSize)
static :: Bool
static = Maybe Rect -> Bool
forall a. Maybe a -> Bool
isJust Maybe Rect
oplace
startplace :: Rect
startplace =
case Maybe Rect
oplace of
Maybe Rect
Nothing -> Int -> Int -> Int -> Int -> Rect
rR Int
0 Int
0 Int
10 Int
10
Just Rect
p -> Rect
p
statlimits :: Rect -> FRequest
statlimits (Rect Point
p Point
s) = LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout (Point -> Point -> Point
padd Point
p Point
s) Bool
True Bool
True)
wf :: F a b
wf =
(Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
forall a b.
(Rect -> FRequest) -> [FRequest] -> Rect -> K a b -> F a b
winF Rect -> FRequest
winCmd
([FRequest]
startcmds [FRequest] -> [FRequest] -> [FRequest]
forall a. [a] -> [a] -> [a]
++
(case Maybe Rect
oplace of
Maybe Rect
Nothing -> []
Just Rect
r -> [Rect -> FRequest
statlimits Rect
r] [FRequest] -> [FRequest] -> [FRequest]
forall a. [a] -> [a] -> [a]
++
(if Bool
nomap then [] else [XCommand -> FRequest
XCmd XCommand
MapRaised])))
Rect
startplace
K a b
k
wff :: F (Either a c) (Either b d)
wff = F (Either a c) (Either b d) -> F (Either a c) (Either b d)
forall hi ho. F hi ho -> F hi ho
adjTag (F a b
wfF a b -> F c d -> F (Either a c) (Either b d)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<F c d
f)
adjTag :: F hi ho -> F hi ho
adjTag = if Bool
newKTag then ((Path, FResponse) -> (Path, FResponse))
-> ((Path, FRequest) -> (Path, FRequest)) -> F hi ho -> F hi ho
forall hi ho.
((Path, FResponse) -> (Path, FResponse))
-> ((Path, FRequest) -> (Path, FRequest)) -> F hi ho -> F hi ho
prepostMapLow (Path, FResponse) -> (Path, FResponse)
forall b. (Path, b) -> (Path, b)
addktag (Path, FRequest) -> (Path, FRequest)
forall b. (Path, b) -> (Path, b)
removektag else F hi ho -> F hi ho
forall a. a -> a
id where
addktag :: (Path, b) -> (Path, b)
addktag ([],b
m) = ([Direction
L],b
m)
addktag (Path, b)
tm = (Path, b)
tm
removektag :: (Path, b) -> (Path, b)
removektag ([Direction
L],b
m) = ([],b
m)
removektag (Path, b)
tm = (Path, b)
tm
windowf :: F (Either a c) (Either b d)
windowf = SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> F (Either a c) (Either b d) -> F (Either a c) (Either b d)
forall i o.
SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
-> F i o -> F i o
loopThroughLowF ((Int, Bool)
-> SP
(Either (Path, FRequest) (Path, FResponse))
(Either (Path, FRequest) (Path, FResponse))
ctrlSP (Int
border_width,Bool
nomap)) F (Either a c) (Either b d)
wff
in case Maybe Rect
oplace of
Maybe Rect
Nothing -> F (Either a c) (Either b d)
windowf
Just Rect
place -> let prep' :: Message (a, FResponse) a -> [(a, FResponse)]
prep' (High a
ltag) = [(a
ltag, LayoutResponse -> FResponse
LEvt (Rect -> LayoutResponse
LayoutPlace Rect
place))]
prep' (Low (a
_, LEvt (LayoutPlace Rect
_))) = []
prep' (Low (a, FResponse)
msg) = [(a, FResponse)
msg]
post' :: (b, FRequest) -> [Message (b, FRequest) b]
post' (b
ltag, LCmd LayoutMessage
_) = [b -> Message (b, FRequest) b
forall a b. b -> Message a b
High b
ltag]
post' (b, FRequest)
cmd = [(b, FRequest) -> Message (b, FRequest) b
forall a b. a -> Message a b
Low (b, FRequest)
cmd]
in SP (Path, FRequest) (FCommand Path)
-> SP (FEvent Path) (Path, FResponse)
-> F (Either a c) (Either b d)
-> F (Either a c) (Either b d)
forall a b c.
SP (Path, FRequest) (FCommand a)
-> SP (FEvent a) (Path, FResponse) -> F b c -> F b c
loopLow (((Path, FRequest) -> [FCommand Path])
-> SP (Path, FRequest) (FCommand Path)
forall t b. (t -> [b]) -> SP t b
concmapSP (Path, FRequest) -> [FCommand Path]
forall b. (b, FRequest) -> [Message (b, FRequest) b]
post') ((FEvent Path -> [(Path, FResponse)])
-> SP (FEvent Path) (Path, FResponse)
forall t b. (t -> [b]) -> SP t b
concmapSP FEvent Path -> [(Path, FResponse)]
forall a. Message (a, FResponse) a -> [(a, FResponse)]
prep') F (Either a c) (Either b d)
windowf