module ScrollF(scrollShellF,
               scrollF,oldScrollF,
               vScrollF,oldVscrollF,
	       hScrollF,oldHscrollF,
	       grabScrollKeys) where
import Fudget
import EitherUtils
import CmdLineEnv(argFlag)
import Utils(remove)
import LayoutRequest
import Geometry
import Command
import FRequest
import Event
import Xtypes

import FreeGroupF
import Dlayout(groupF)
import DShellF(shellF)
import Spops
import NullF(nullF)
import Cont(waitForSP)
import SpEither(mapFilterSP)
import DragF(hPotF',vPotF',PotRequest(..))
import Placer(tableF,hBoxF,vBoxF)
import SerCompF(absF)
import Loops(loopThroughRightF)
import CompOps
--import Maptrace(ctrace)

scrollShellF :: [Char] -> (Point, Point) -> F c d -> F c d
scrollShellF [Char]
name (Point, Point)
initlimits = [Char] -> F c d -> F c d
forall c d. [Char] -> F c d -> F c d
shellF [Char]
name (F c d -> F c d) -> (F c d -> F c d) -> F c d -> F c d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> (Point, Point) -> F c d -> F c d
forall b d. Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
True (Point, Point)
initlimits

grabScrollKeys :: Bool
grabScrollKeys = [Char] -> Bool -> Bool
argFlag [Char]
"grabscrollkeys" Bool
False
 -- True is not good if there are two or more scrollFs in the same shell window.

-- Std versions with arbirarily chosen limits...
scrollF :: F b d -> F b d
scrollF = Bool -> (Point, Point) -> F b d -> F b d
forall b d. Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
grabScrollKeys (Int -> Int -> Point
pP Int
50 Int
30,Int -> Int -> Point
pP Int
550 Int
700)
vScrollF :: F b d -> F b d
vScrollF = Bool -> (Point, Point) -> F b d -> F b d
forall b d. Bool -> (Point, Point) -> F b d -> F b d
oldVscrollF Bool
grabScrollKeys (Int -> Int -> Point
pP Int
50 Int
30,Int -> Int -> Point
pP Int
550 Int
700)
hScrollF :: F b d -> F b d
hScrollF = Bool -> (Point, Point) -> F b d -> F b d
forall b d. Bool -> (Point, Point) -> F b d -> F b d
oldHscrollF Bool
grabScrollKeys (Int -> Int -> Point
pP Int
50 Int
10,Int -> Int -> Point
pP Int
550 Int
700)

scroll :: Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest PotRequest) (Either PotState PotState))
scroll Bool
foc = (a -> b -> a
forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
plainAdjLayout,Int -> F a b -> F a b
forall a b. Int -> F a b -> F a b
tableF Int
2,Bool -> Maybe Point -> F PotRequest PotState
vPotF' Bool
foc Maybe Point
forall a. Maybe a
Nothing F PotRequest PotState
-> F PotRequest PotState
-> F (Either PotRequest PotRequest) (Either PotState PotState)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< Bool -> Maybe Point -> F PotRequest PotState
hPotF' Bool
foc Maybe Point
forall a. Maybe a
Nothing)
vscroll :: Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest c) (Either PotState d))
vscroll Bool
foc = (a -> b -> a
forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
wAdjLayout,F a b -> F a b
forall a b. F a b -> F a b
hBoxF,Bool -> Maybe Point -> F PotRequest PotState
vPotF' Bool
foc Maybe Point
forall a. Maybe a
Nothing F PotRequest PotState
-> F c d -> F (Either PotRequest c) (Either PotState d)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+< F c d
forall hi ho. F hi ho
nullF)
hscroll :: Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either a PotRequest) (Either b PotState))
hscroll Bool
foc = (a -> b -> a
forall a b. a -> b -> a
const,LayoutRequest -> Point -> Point
hAdjLayout,F a b -> F a b
forall a b. F a b -> F a b
vBoxF,F a b
forall hi ho. F hi ho
nullFF a b
-> F PotRequest PotState
-> F (Either a PotRequest) (Either b PotState)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<Bool -> Maybe Point -> F PotRequest PotState
hPotF' Bool
foc Maybe Point
forall a. Maybe a
Nothing)

oldScrollF :: Bool -> (Point, Point) -> F b d -> F b d
oldScrollF Bool
grabKeys  = (Any -> Any -> Any, LayoutRequest -> Point -> Point,
 F (Either
      (Either
         (Either Point (Either Point Point)) (Either PotRequest PotRequest))
      b)
   (Either
      (Either
         (Either (Either (ModState, [Char]) Point) LayoutMessage)
         (Either PotState PotState))
      d)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either PotState PotState))
         d),
 F (Either PotRequest PotRequest) (Either PotState PotState))
-> Bool -> (Point, Point) -> F b d -> F b d
forall a c inr b b b b c b c d.
(a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (Bool
-> (Any -> Any -> Any, LayoutRequest -> Point -> Point,
    F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either PotState PotState))
         d)
    -> F (Either
            (Either
               (Either Point (Either Point Point)) (Either PotRequest PotRequest))
            b)
         (Either
            (Either
               (Either (Either (ModState, [Char]) Point) LayoutMessage)
               (Either PotState PotState))
            d),
    F (Either PotRequest PotRequest) (Either PotState PotState))
forall a b a b.
Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest PotRequest) (Either PotState PotState))
scroll  (Bool -> Bool
not Bool
grabKeys)) Bool
grabKeys
oldVscrollF :: Bool -> (Point, Point) -> F b d -> F b d
oldVscrollF Bool
grabKeys = (Any -> Any -> Any, LayoutRequest -> Point -> Point,
 F (Either
      (Either
         (Either Point (Either Point Point)) (Either PotRequest PotRequest))
      b)
   (Either
      (Either
         (Either (Either (ModState, [Char]) Point) LayoutMessage)
         (Either PotState (Int, Any, Any)))
      d)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either PotState (Int, Any, Any)))
         d),
 F (Either PotRequest PotRequest) (Either PotState (Int, Any, Any)))
-> Bool -> (Point, Point) -> F b d -> F b d
forall a c inr b b b b c b c d.
(a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (Bool
-> (Any -> Any -> Any, LayoutRequest -> Point -> Point,
    F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either PotState (Int, Any, Any)))
         d)
    -> F (Either
            (Either
               (Either Point (Either Point Point)) (Either PotRequest PotRequest))
            b)
         (Either
            (Either
               (Either (Either (ModState, [Char]) Point) LayoutMessage)
               (Either PotState (Int, Any, Any)))
            d),
    F (Either PotRequest PotRequest) (Either PotState (Int, Any, Any)))
forall a b a b c d.
Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either PotRequest c) (Either PotState d))
vscroll (Bool -> Bool
not Bool
grabKeys)) Bool
grabKeys
oldHscrollF :: Bool -> (Point, Point) -> F b d -> F b d
oldHscrollF Bool
grabKeys = (Any -> Any -> Any, LayoutRequest -> Point -> Point,
 F (Either
      (Either
         (Either Point (Either Point Point)) (Either PotRequest PotRequest))
      b)
   (Either
      (Either
         (Either (Either (ModState, [Char]) Point) LayoutMessage)
         (Either (Int, Any, Any) PotState))
      d)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either (Int, Any, Any) PotState))
         d),
 F (Either PotRequest PotRequest) (Either (Int, Any, Any) PotState))
-> Bool -> (Point, Point) -> F b d -> F b d
forall a c inr b b b b c b c d.
(a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (Bool
-> (Any -> Any -> Any, LayoutRequest -> Point -> Point,
    F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either (Int, Any, Any) PotState))
         d)
    -> F (Either
            (Either
               (Either Point (Either Point Point)) (Either PotRequest PotRequest))
            b)
         (Either
            (Either
               (Either (Either (ModState, [Char]) Point) LayoutMessage)
               (Either (Int, Any, Any) PotState))
            d),
    F (Either PotRequest PotRequest) (Either (Int, Any, Any) PotState))
forall a b a b a b.
Bool
-> (a -> b -> a, LayoutRequest -> Point -> Point, F a b -> F a b,
    F (Either a PotRequest) (Either b PotState))
hscroll (Bool -> Bool
not Bool
grabKeys)) Bool
grabKeys

gScrollF :: (a, LayoutRequest -> Point -> Point,
 F (Either (Either (Either Point (Either Point Point)) c) inr)
   (Either
      (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
      b)
 -> F (Either
         (Either
            (Either Point (Either Point Point)) (Either PotRequest PotRequest))
         b)
      (Either
         (Either
            (Either (Either (ModState, [Char]) Point) LayoutMessage)
            (Either (Int, b, c) (Int, b, c)))
         d),
 F c b)
-> Bool -> (Point, Point) -> F inr b -> F b d
gScrollF (a
outCoupling,LayoutRequest -> Point -> Point
inCoupling,F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
     b)
-> F (Either
        (Either
           (Either Point (Either Point Point)) (Either PotRequest PotRequest))
        b)
     (Either
        (Either
           (Either (Either (ModState, [Char]) Point) LayoutMessage)
           (Either (Int, b, c) (Int, b, c)))
        d)
placer,F c b
scrollbarsF) Bool
grabKeys (Point, Point)
initlimits F inr b
fud =
    F (Either
     (Either
        (Either Point (Either Point Point)) (Either PotRequest PotRequest))
     b)
  (Either
     (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     d)
-> F (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either Point (Either Point Point)) (Either PotRequest PotRequest))
-> F b d
forall a b c d. F (Either a b) (Either c d) -> F c a -> F b d
loopThroughRightF (F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
     b)
-> F (Either
        (Either
           (Either Point (Either Point Point)) (Either PotRequest PotRequest))
        b)
     (Either
        (Either
           (Either (Either (ModState, [Char]) Point) LayoutMessage)
           (Either (Int, b, c) (Int, b, c)))
        d)
placer F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
     b)
mainF) (SP
  (Either
     (Either (Either (ModState, [Char]) Point) LayoutMessage)
     (Either (Int, b, c) (Int, b, c)))
  (Either
     (Either Point (Either Point Point)) (Either PotRequest PotRequest))
-> F (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either Point (Either Point Point)) (Either PotRequest PotRequest))
forall a b. SP a b -> F a b
absF ((Point
 -> Point
 -> (Point -> Point)
 -> SP
      (Either
         (Either (Either (ModState, [Char]) Point) LayoutMessage)
         (Either (Int, b, c) (Int, b, c)))
      (Either
         (Either Point (Either Point Point))
         (Either PotRequest PotRequest)))
-> SP
     (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either Point (Either Point Point)) (Either PotRequest PotRequest))
forall a b b b.
(Point
 -> Point
 -> (Point -> Point)
 -> SP
      (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
initSP Point
-> Point
-> (Point -> Point)
-> SP
     (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either Point (Either Point Point)) (Either PotRequest PotRequest))
forall b c b c a.
Point
-> Point
-> (Point -> Point)
-> SP
     (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either a (Either Point Point)) (Either PotRequest PotRequest))
ctrlSP))
  where
    mainF :: F (Either (Either (Either Point (Either Point Point)) c) inr)
  (Either
     (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
     b)
mainF =
        Either
  (Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
  b
-> Either
     (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
     b
forall a b b b.
Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
post(Either
   (Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
   b
 -> Either
      (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
      b)
-> F (Either (Either Point (Either (Either Point Point) inr)) c)
     (Either
        (Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
        b)
-> F (Either (Either Point (Either (Either Point Point) inr)) c)
     (Either
        (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
        b)
forall a b e. (a -> b) -> F e a -> F e b
>^=<
	([FRequest]
-> K Point (Either (ModState, [Char]) Point)
-> F (Either (Either Point Point) inr) (Either LayoutMessage b)
-> F (Either Point (Either (Either Point Point) inr))
     (Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
forall a b c d.
[FRequest] -> K a b -> F c d -> F (Either a c) (Either b d)
groupF [FRequest]
start K Point (Either (ModState, [Char]) Point)
visibleK (F inr b
-> F (Either (Either Point Point) inr) (Either LayoutMessage b)
forall inr outr.
F inr outr
-> F (Either (Either Point Point) inr) (Either LayoutMessage outr)
freeGroupF F inr b
fud)F (Either Point (Either (Either Point Point) inr))
  (Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
-> F c b
-> F (Either (Either Point (Either (Either Point Point) inr)) c)
     (Either
        (Either (Either (ModState, [Char]) Point) (Either LayoutMessage b))
        b)
forall a b c d. F a b -> F c d -> F (Either a c) (Either b d)
>+<F c b
scrollbarsF)
	F (Either (Either Point (Either (Either Point Point) inr)) c)
  (Either
     (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
     b)
-> (Either (Either (Either Point (Either Point Point)) c) inr
    -> Either (Either Point (Either (Either Point Point) inr)) c)
-> F (Either (Either (Either Point (Either Point Point)) c) inr)
     (Either
        (Either (Either (Either (ModState, [Char]) Point) LayoutMessage) b)
        b)
forall c d e. F c d -> (e -> c) -> F e d
>=^<Either (Either (Either Point (Either Point Point)) c) inr
-> Either (Either Point (Either (Either Point Point) inr)) c
forall a a b b.
Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
pre
      where
        post :: Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
post = Either (Either (Either a b) b) b
-> Either (Either (Either a b) b) b
forall a b b. Either (Either a b) b -> Either (Either a b) b
swapRight(Either (Either (Either a b) b) b
 -> Either (Either (Either a b) b) b)
-> (Either (Either a (Either b b)) b
    -> Either (Either (Either a b) b) b)
-> Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Either a (Either b b) -> Either (Either a b) b)
-> (b -> b)
-> Either (Either a (Either b b)) b
-> Either (Either (Either a b) b) b
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither Either a (Either b b) -> Either (Either a b) b
forall a b b. Either a (Either b b) -> Either (Either a b) b
assocLeft b -> b
forall a. a -> a
id -- (KV+(T+a))+S -> ((KV+T)+S)+a
	pre :: Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
pre = (Either (Either a a) b -> Either a (Either a b))
-> (b -> b)
-> Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
forall t1 a t2 b.
(t1 -> a) -> (t2 -> b) -> Either t1 t2 -> Either a b
mapEither Either (Either a a) b -> Either a (Either a b)
forall a a b. Either (Either a a) b -> Either a (Either a b)
assocRight b -> b
forall a. a -> a
id(Either (Either (Either a a) b) b
 -> Either (Either a (Either a b)) b)
-> (Either (Either (Either a a) b) b
    -> Either (Either (Either a a) b) b)
-> Either (Either (Either a a) b) b
-> Either (Either a (Either a b)) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Either (Either (Either a a) b) b
-> Either (Either (Either a a) b) b
forall a b b. Either (Either a b) b -> Either (Either a b) b
swapRight -- converse

        start :: [FRequest]
start = (XCommand -> FRequest) -> [XCommand] -> [FRequest]
forall a b. (a -> b) -> [a] -> [b]
map XCommand -> FRequest
XCmd ([XCommand] -> [FRequest]) -> [XCommand] -> [FRequest]
forall a b. (a -> b) -> a -> b
$
	        [XCommand]
transinit[XCommand] -> [XCommand] -> [XCommand]
forall a. [a] -> [a] -> [a]
++
	        [[WindowAttributes] -> XCommand
ChangeWindowAttributes [PixmapId -> WindowAttributes
CWBackPixmap PixmapId
parentRelative],
		 [WindowChanges] -> XCommand
ConfigureWindow [Int -> WindowChanges
CWBorderWidth Int
1]]

	transinit :: [XCommand]
transinit =
	    if Bool
grabKeys
	    then [(XEvent -> Maybe XEvent) -> [EventMask] -> XCommand
TranslateEvent XEvent -> Maybe XEvent
tobutton [EventMask
KeyPressMask]]
	    else []

      --tobutton k@(KeyEvent t p1 p2 s Pressed _ ks _) | (s, ks) `elem` keys =
	tobutton :: XEvent -> Maybe XEvent
tobutton e :: XEvent
e@(KeyEvent {state :: XEvent -> ModState
state=ModState
s,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> [Char]
keySym=[Char]
ks})
	           | (ModState
s, [Char]
ks) (ModState, [Char]) -> [(ModState, [Char])] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [(ModState, [Char])]
keys =
	    XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just XEvent
e
        -- Mouse Wheel support:
	tobutton e :: XEvent
e@(ButtonEvent {button :: XEvent -> Button
button=Button Int
4,type' :: XEvent -> Pressed
type'=Pressed
Pressed}) = XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just XEvent
e
	tobutton e :: XEvent
e@(ButtonEvent {button :: XEvent -> Button
button=Button Int
5,type' :: XEvent -> Pressed
type'=Pressed
Pressed}) = XEvent -> Maybe XEvent
forall a. a -> Maybe a
Just XEvent
e
	tobutton XEvent
_ = Maybe XEvent
forall a. Maybe a
Nothing

        keys :: [(ModState, [Char])]
keys = ([Char] -> (ModState, [Char])) -> [[Char]] -> [(ModState, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((,) []) [[Char]]
keys' [(ModState, [Char])]
-> [(ModState, [Char])] -> [(ModState, [Char])]
forall a. [a] -> [a] -> [a]
++ ([Char] -> (ModState, [Char])) -> [[Char]] -> [(ModState, [Char])]
forall a b. (a -> b) -> [a] -> [b]
map ((,) [Modifiers
Shift]) [[Char]]
keys'
	  where keys' :: [[Char]]
keys' = [[Char]
"Prior",[Char]
"Next",[Char]
"Home",[Char]
"End"]

    -- visibleK reports the current visible size and grabbed keys
    visibleK :: K Point (Either (ModState, [Char]) Point)
visibleK = KSP Point (Either (ModState, [Char]) Point)
-> K Point (Either (ModState, [Char]) Point)
forall hi ho. KSP hi ho -> K hi ho
K{-kk-} (KSP Point (Either (ModState, [Char]) Point)
 -> K Point (Either (ModState, [Char]) Point))
-> KSP Point (Either (ModState, [Char]) Point)
-> K Point (Either (ModState, [Char]) Point)
forall a b. (a -> b) -> a -> b
$ (Message FResponse Point
 -> Maybe (Message FRequest (Either (ModState, [Char]) Point)))
-> KSP Point (Either (ModState, [Char]) Point)
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP Message FResponse Point
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
visible
      where
	visible :: Message FResponse Point
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
visible (Low (LEvt (LayoutSize Point
vissize))) = Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High (Point -> Either (ModState, [Char]) Point
forall a b. b -> Either a b
Right Point
vissize))
	visible (Low (XEvt (KeyEvent{state :: XEvent -> ModState
state=ModState
mods,type' :: XEvent -> Pressed
type'=Pressed
Pressed,keySym :: XEvent -> [Char]
keySym=[Char]
key}))) =
	    Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High ((ModState, [Char]) -> Either (ModState, [Char]) Point
forall a b. a -> Either a b
Left (ModState
mods,[Char]
key)))
	visible (Low (XEvt (ButtonEvent{button :: XEvent -> Button
button=Button Int
4,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods}))) =
	    Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High ((ModState, [Char]) -> Either (ModState, [Char]) Point
forall a b. a -> Either a b
Left (ModState
mods,[Char]
"Prior")))
	visible (Low (XEvt (ButtonEvent{button :: XEvent -> Button
button=Button Int
5,type' :: XEvent -> Pressed
type'=Pressed
Pressed,state :: XEvent -> ModState
state=ModState
mods}))) =
	    Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (Either (ModState, [Char]) Point
-> Message FRequest (Either (ModState, [Char]) Point)
forall a b. b -> Message a b
High ((ModState, [Char]) -> Either (ModState, [Char]) Point
forall a b. a -> Either a b
Left (ModState
mods,[Char]
"Next")))
	visible (High Point
vissize) =
	    Message FRequest (Either (ModState, [Char]) Point)
-> Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. a -> Maybe a
Just (FRequest -> Message FRequest (Either (ModState, [Char]) Point)
forall a b. a -> Message a b
Low (LayoutRequest -> FRequest
layoutRequestCmd (Point -> Bool -> Bool -> LayoutRequest
plainLayout Point
vissize Bool
False Bool
False)))
	visible Message FResponse Point
_ = Maybe (Message FRequest (Either (ModState, [Char]) Point))
forall a. Maybe a
Nothing

    initSP :: (Point
 -> Point
 -> (Point -> Point)
 -> SP
      (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
initSP Point
-> Point
-> (Point -> Point)
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
cont =
        (Either (Either a LayoutMessage) b -> Maybe LayoutRequest)
-> (LayoutRequest
    -> SP
         (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
forall a t b. (a -> Maybe t) -> (t -> SP a b) -> SP a b
waitForSP Either (Either a LayoutMessage) b -> Maybe LayoutRequest
forall a b.
Either (Either a LayoutMessage) b -> Maybe LayoutRequest
initreq ((LayoutRequest
  -> SP
       (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
 -> SP
      (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> (LayoutRequest
    -> SP
         (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
forall a b. (a -> b) -> a -> b
$ \ LayoutRequest
req ->
	let vissize :: Point
vissize = (Point, Point) -> Point -> Point
limit (Point, Point)
initlimits Point
rtotsize
            rtotsize :: Point
rtotsize = LayoutRequest -> Point
minsize LayoutRequest
req
	    adj :: Point -> Point
adj = LayoutRequest -> Point -> Point
inCoupling LayoutRequest
req
	in Either (Either Point b) b
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
forall b a. b -> SP a b -> SP a b
putSP (Either Point b -> Either (Either Point b) b
forall a b. a -> Either a b
Left (Point -> Either Point b
forall a b. a -> Either a b
Left Point
vissize)) (SP (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
 -> SP
      (Either (Either a LayoutMessage) b) (Either (Either Point b) b))
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
forall a b. (a -> b) -> a -> b
$
	   Point
-> Point
-> (Point -> Point)
-> SP
     (Either (Either a LayoutMessage) b) (Either (Either Point b) b)
cont Point
vissize Point
rtotsize Point -> Point
adj
      where initreq :: Either (Either a LayoutMessage) b -> Maybe LayoutRequest
initreq (Left (Right (LayoutRequest LayoutRequest
req))) = LayoutRequest -> Maybe LayoutRequest
forall a. a -> Maybe a
Just LayoutRequest
req
            initreq Either (Either a LayoutMessage) b
_ = Maybe LayoutRequest
forall a. Maybe a
Nothing

    -- ctrlSP :: SP ((KV+T)+S) ((V+T)+S)
    -- cltrSP implements the scrolling
    -- Input : KV = grabbed keys or visible size (from visibleK)
    --       : T = total size (from freeGroupF)
    --       : S = scroll bar positions
    -- Output: V = requested visible size (to visibleK)
    --         S = scroll bar adjustments on size changes
    --         T = position adjustments on scroll bar changes,
    --             notification of current visible size
    ctrlSP :: Point
-> Point
-> (Point -> Point)
-> SP
     (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either a (Either Point Point)) (Either PotRequest PotRequest))
ctrlSP Point
visible Point
total Point -> Point
adj =
        ((Point, Point, Point, Point -> Point)
 -> Either
      (Either (Either (ModState, [Char]) Point) LayoutMessage)
      (Either (Int, b, c) (Int, b, c))
 -> ((Point, Point, Point, Point -> Point),
     [Either
        (Either a (Either Point Point)) (Either PotRequest PotRequest)]))
-> (Point, Point, Point, Point -> Point)
-> SP
     (Either
        (Either (Either (ModState, [Char]) Point) LayoutMessage)
        (Either (Int, b, c) (Int, b, c)))
     (Either
        (Either a (Either Point Point)) (Either PotRequest PotRequest))
forall t a b. (t -> a -> (t, [b])) -> t -> SP a b
concatMapAccumlSP (Point, Point, Point, Point -> Point)
-> Either
     (Either (Either (ModState, [Char]) Point) LayoutMessage)
     (Either (Int, b, c) (Int, b, c))
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
forall b c b c a.
(Point, Point, Point, Point -> Point)
-> Either
     (Either (Either (ModState, [Char]) Point) LayoutMessage)
     (Either (Int, b, c) (Int, b, c))
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
ctrlT (Point
visible, Point
total, Int -> Int -> Point
pP Int
0 Int
0,Point -> Point
adj) -- limits??
      where
        ctrlT :: (Point, Point, Point, Point -> Point)
-> Either
     (Either (Either (ModState, [Char]) Point) LayoutMessage)
     (Either (Int, b, c) (Int, b, c))
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
ctrlT s :: (Point, Point, Point, Point -> Point)
s@(Point
visible, Point
total, Point
pos, Point -> Point
adj) Either
  (Either (Either (ModState, [Char]) Point) LayoutMessage)
  (Either (Int, b, c) (Int, b, c))
msg =
	    case Either
  (Either (Either (ModState, [Char]) Point) LayoutMessage)
  (Either (Int, b, c) (Int, b, c))
msg of
	      Left (Left (Left (ModState, [Char])
key)) -> ((Point, Point, Point, Point -> Point)
s,(ModState, [Char])
-> [Either
      (Either a (Either Point Point)) (Either PotRequest PotRequest)]
forall a.
(ModState, [Char]) -> [Either a (Either PotRequest PotRequest)]
potKeyInput (ModState, [Char])
key)
	      Left (Left (Right Point
visible')) -> Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
forall a b.
Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point b)) (Either PotRequest PotRequest)])
adjustVisible Point
visible' Point -> Point
adj
	      Left (Right LayoutMessage
req) ->
	        case LayoutMessage
req of
		  LayoutRequest LayoutRequest
req -> Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
forall a b.
Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point b)) (Either PotRequest PotRequest)])
adjustVisible Point
visible Point -> Point
adj'
		     where adj' :: Point -> Point
adj' = LayoutRequest -> Point -> Point
inCoupling LayoutRequest
req
		  LayoutMakeVisible Rect
rect (Maybe Alignment, Maybe Alignment)
align ->
		    ((Point, Point, Point, Point -> Point)
s, Rect
-> (Maybe Alignment, Maybe Alignment)
-> [Either
      (Either a (Either Point Point)) (Either PotRequest PotRequest)]
forall a.
Rect
-> (Maybe Alignment, Maybe Alignment)
-> [Either a (Either PotRequest PotRequest)]
mkvisible Rect
rect (Maybe Alignment, Maybe Alignment)
align)
		  --LayoutScrollStep step -> ...
		  LayoutMessage
_ -> ((Point, Point, Point, Point -> Point)
s, [])
	      Right (Left (Int
y,b
_,c
_)) -> Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
forall a a b.
Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
vmove Point
pos (-Int
y)
	      Right (Right (Int
x,b
_,c
_)) -> Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point Point)) (Either PotRequest PotRequest)])
forall a a b.
Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
hmove Point
pos (-Int
x)
	  where
	    potKeyInput :: (ModState, [Char]) -> [Either a (Either PotRequest PotRequest)]
potKeyInput key :: (ModState, [Char])
key@(ModState
mods,[Char]
k) =
	      if Modifiers
Shift Modifiers -> ModState -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ModState
mods
	      then [Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. b -> Either a b
Right ((ModState, [Char]) -> PotRequest
PotInput (Modifiers -> ModState -> ModState
forall t. Eq t => t -> [t] -> [t]
remove Modifiers
Shift ModState
mods,[Char]
k)))]
	      else [Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. a -> Either a b
Left  ((ModState, [Char]) -> PotRequest
PotInput (ModState, [Char])
key))]
	    adjustVisible :: Point
-> (Point -> Point)
-> ((Point, Point, Point, Point -> Point),
    [Either
       (Either a (Either Point b)) (Either PotRequest PotRequest)])
adjustVisible Point
visible' Point -> Point
adj' =
		((Point
visible', Point
total', Point
pos, Point -> Point
adj'),
		 Either a (Either Point b)
-> Either
     (Either a (Either Point b)) (Either PotRequest PotRequest)
forall a b. a -> Either a b
Left (Either Point b -> Either a (Either Point b)
forall a b. b -> Either a b
Right (Point -> Either Point b
forall a b. a -> Either a b
Left Point
total'))Either (Either a (Either Point b)) (Either PotRequest PotRequest)
-> [Either
      (Either a (Either Point b)) (Either PotRequest PotRequest)]
-> [Either
      (Either a (Either Point b)) (Either PotRequest PotRequest)]
forall a. a -> [a] -> [a]
:
		 Point
-> Point
-> [Either
      (Either a (Either Point b)) (Either PotRequest PotRequest)]
forall a.
Point -> Point -> [Either a (Either PotRequest PotRequest)]
adjustPots Point
visible' Point
total')
	      where total' :: Point
total' = Point -> Point
adj' Point
visible'
	    adjustPots :: Point -> Point -> [Either a (Either PotRequest PotRequest)]
adjustPots (Point Int
visw Int
vish) size :: Point
size@(Point Int
totw Int
toth) =
		    [Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. b -> Either a b
Right (Int -> Int -> PotRequest
ResizePot Int
visw Int
totw)),
		     Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. a -> Either a b
Left (Int -> Int -> PotRequest
ResizePot Int
vish Int
toth))]
	    mkvisible :: Rect
-> (Maybe Alignment, Maybe Alignment)
-> [Either a (Either PotRequest PotRequest)]
mkvisible r :: Rect
r@(Rect (Point Int
x Int
y) (Point Int
w Int
h)) (Maybe Alignment
halign,Maybe Alignment
valign) =
	      --ctrace "mkvisible" r $
		    [Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. b -> Either a b
Right (Int -> Int -> Maybe Alignment -> PotRequest
PotMkVisible Int
x Int
w Maybe Alignment
halign)),
		     Either PotRequest PotRequest
-> Either a (Either PotRequest PotRequest)
forall a b. b -> Either a b
Right (PotRequest -> Either PotRequest PotRequest
forall a b. a -> Either a b
Left (Int -> Int -> Maybe Alignment -> PotRequest
PotMkVisible Int
y Int
h Maybe Alignment
valign))]
	    vmove :: Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
vmove pos :: Point
pos@(Point Int
x Int
_) Int
y =
	        --ctrace "vmove" (pos,pos') $
	        ((Point
visible,Point
total,Point
pos',Point -> Point
adj),[Either a (Either a Point) -> Either (Either a (Either a Point)) b
forall a b. a -> Either a b
Left (Either a Point -> Either a (Either a Point)
forall a b. b -> Either a b
Right (Point -> Either a Point
forall a b. b -> Either a b
Right Point
pos'))])
	      where pos' :: Point
pos' = Int -> Int -> Point
Point Int
x Int
y
	    hmove :: Point
-> Int
-> ((Point, Point, Point, Point -> Point),
    [Either (Either a (Either a Point)) b])
hmove pos :: Point
pos@(Point Int
_ Int
y) Int
x =
	        --ctrace "hmove" (pos,pos')
	        ((Point
visible,Point
total,Point
pos',Point -> Point
adj),[Either a (Either a Point) -> Either (Either a (Either a Point)) b
forall a b. a -> Either a b
Left (Either a Point -> Either a (Either a Point)
forall a b. b -> Either a b
Right (Point -> Either a Point
forall a b. b -> Either a b
Right Point
pos'))])
	      where pos' :: Point
pos' = Int -> Int -> Point
Point Int
x Int
y


limit :: (Point, Point) -> Point -> Point
limit (Point
min', Point
max') Point
size = Point -> Point -> Point
pmax Point
min' (Point -> Point -> Point
pmin Point
max' Point
size)


type SizeCoupling = Size    -> Size      -> Size
--                  my size    other size   my new size

stdCoupling :: Point -> Point -> Point
stdCoupling = Point -> Point -> Point
pmax
vCoupling :: Point -> Point -> Point
vCoupling (Point Int
tw Int
th) (Point Int
vw Int
vh) = Int -> Int -> Point
Point Int
vw (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
th Int
vh)
hCoupling :: Point -> Point -> Point
hCoupling (Point Int
tw Int
th) (Point Int
vw Int
vh) = Int -> Int -> Point
Point (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
tw Int
vw) Int
vh

plainAdjLayout :: LayoutRequest -> Point -> Point
plainAdjLayout (Layout {minsize :: LayoutRequest -> Point
minsize=Point
total'}) = Point -> Point -> Point
stdCoupling Point
total'
wAdjLayout :: LayoutRequest -> Point -> Point
wAdjLayout (Layout {wAdj :: LayoutRequest -> Int -> Point
wAdj=Int -> Point
wa}) = (Point -> Point -> Point) -> (Point -> Point) -> Point -> Point
forall t t t. (t -> t -> t) -> (t -> t) -> t -> t
s ((Point -> Point -> Point) -> Point -> Point -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Point -> Point
vCoupling) (Int -> Point
wa (Int -> Point) -> (Point -> Int) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Int
xcoord)
hAdjLayout :: LayoutRequest -> Point -> Point
hAdjLayout (Layout {hAdj :: LayoutRequest -> Int -> Point
hAdj=Int -> Point
ha}) = (Point -> Point -> Point) -> (Point -> Point) -> Point -> Point
forall t t t. (t -> t -> t) -> (t -> t) -> t -> t
s ((Point -> Point -> Point) -> Point -> Point -> Point
forall a b c. (a -> b -> c) -> b -> a -> c
flip Point -> Point -> Point
hCoupling) (Int -> Point
ha (Int -> Point) -> (Point -> Int) -> Point -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point -> Int
ycoord)

s :: (t -> t -> t) -> (t -> t) -> t -> t
s t -> t -> t
f t -> t
g t
x = t -> t -> t
f t
x (t -> t
g t
x)

-- assocLeft :: a+(b+c) -> (a+b)+c
-- assocRight :: (a+b)+c -> a+(b+c)
assocLeft :: Either a (Either b b) -> Either (Either a b) b
assocLeft = (a -> Either (Either a b) b)
-> (Either b b -> Either (Either a b) b)
-> Either a (Either b b)
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (a -> Either a b) -> a -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) ((b -> Either (Either a b) b)
-> (b -> Either (Either a b) b)
-> Either b b
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (b -> Either a b) -> b -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right) b -> Either (Either a b) b
forall a b. b -> Either a b
Right)
assocRight :: Either (Either a a) b -> Either a (Either a b)
assocRight = (Either a a -> Either a (Either a b))
-> (b -> Either a (Either a b))
-> Either (Either a a) b
-> Either a (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either a (Either a b))
-> (a -> Either a (Either a b))
-> Either a a
-> Either a (Either a b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Either a (Either a b)
forall a b. a -> Either a b
Left (Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right(Either a b -> Either a (Either a b))
-> (a -> Either a b) -> a -> Either a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left)) (Either a b -> Either a (Either a b)
forall a b. b -> Either a b
Right(Either a b -> Either a (Either a b))
-> (b -> Either a b) -> b -> Either a (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right)

--swapRight :: (a+b)+c -> (a+c)+b
swapRight :: Either (Either a b) b -> Either (Either a b) b
swapRight = (Either a b -> Either (Either a b) b)
-> (b -> Either (Either a b) b)
-> Either (Either a b) b
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((a -> Either (Either a b) b)
-> (b -> Either (Either a b) b)
-> Either a b
-> Either (Either a b) b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (a -> Either a b) -> a -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left) b -> Either (Either a b) b
forall a b. b -> Either a b
Right) (Either a b -> Either (Either a b) b
forall a b. a -> Either a b
Left(Either a b -> Either (Either a b) b)
-> (b -> Either a b) -> b -> Either (Either a b) b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either a b
forall a b. b -> Either a b
Right)