module ToggleGroupF(toggleGroupF) where
import ButtonGroupF
import CompOps((>=^^<))
import Spops(mapstateSP)
import Fudget
--import Geometry(Line(..), Point(..), Rect(..), Size(..))
--import Message(Message)
import SerCompF(idLeftF)
import Xtypes(KeySym(..), ModState(..))

toggleGroupF :: [(ModState, KeySym)] -> (F (Either (Either Bool Bool) a) b) -> F (Either Bool a) (Either Bool b)
toggleGroupF :: forall a b.
[(ModState, KeySym)]
-> F (Either (Either Bool Bool) a) b
-> F (Either Bool a) (Either Bool b)
toggleGroupF [(ModState, KeySym)]
keys F (Either (Either Bool Bool) a) b
f =
    let toPressed :: a -> Either a (Either (Either a b) b)
toPressed = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left
        toStateF :: a -> Either a (Either (Either a a) b)
toStateF = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
        toFudget :: a -> Either a (Either a a)
toFudget = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right
        through :: a -> Either a b
through = forall a b. a -> Either a b
Left
        change :: a -> (a, [Either a (Either (Either a a) b)])
change a
s = (a
s, [forall {a} {a} {a} {b}. a -> Either a (Either (Either a a) b)
toStateF a
s, forall a b. a -> Either a b
through a
s])
        prep :: Bool
-> Either BMevents (Either Bool b)
-> (Bool, [Either Bool (Either (Either Bool Bool) b)])
prep Bool
s (Right (Left Bool
ns)) = forall {a} {a} {b}. a -> (a, [Either a (Either (Either a a) b)])
change Bool
ns
        prep Bool
s (Left BMevents
BMClick) = forall {a} {a} {b}. a -> (a, [Either a (Either (Either a a) b)])
change (Bool -> Bool
not Bool
s)
        prep Bool
s (Left BMevents
BMNormal) = (Bool
s, [forall {a} {a} {b} {b}. a -> Either a (Either (Either a b) b)
toPressed Bool
False])
        prep Bool
s (Left BMevents
BMInverted) = (Bool
s, [forall {a} {a} {b} {b}. a -> Either a (Either (Either a b) b)
toPressed Bool
True])
        prep Bool
s (Right (Right b
m)) = (Bool
s, [forall {a} {a} {a}. a -> Either a (Either a a)
toFudget b
m])
    in  forall {b} {c}.
[(ModState, KeySym)] -> F (Either BMevents b) c -> F b c
buttonGroupF [(ModState, KeySym)]
keys (forall {c} {d} {b}. F c d -> F (Either b c) (Either b d)
idLeftF F (Either (Either Bool Bool) a) b
f forall c d e. F c d -> SP e c -> F e d
>=^^< forall {t} {a} {b}. (t -> a -> (t, [b])) -> t -> SP a b
mapstateSP forall {b}.
Bool
-> Either BMevents (Either Bool b)
-> (Bool, [Either Bool (Either (Either Bool Bool) b)])
prep Bool
False)