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 :: [(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 = Either (Either a b) b -> Either a (Either (Either a b) b)
forall a b. b -> Either a b
Right (Either (Either a b) b -> Either a (Either (Either a b) b))
-> (a -> Either (Either a b) b)
-> a
-> Either a (Either (Either a b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
        toStateF :: b -> Either a (Either (Either a b) b)
toStateF = Either (Either a b) b -> Either a (Either (Either a b) b)
forall a b. b -> Either a b
Right (Either (Either a b) b -> Either a (Either (Either a b) b))
-> (b -> Either (Either a b) b)
-> b
-> Either a (Either (Either a b) b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
        toFudget :: b -> Either a (Either a b)
toFudget = 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
        through :: a -> Either a b
through = a -> Either a b
forall a b. a -> Either a b
Left
        change :: a -> (a, [Either a (Either (Either a a) b)])
change a
s = (a
s, [a -> Either a (Either (Either a a) b)
forall b a a b. b -> Either a (Either (Either a b) b)
toStateF a
s, a -> Either a (Either (Either a a) b)
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)) = Bool -> (Bool, [Either Bool (Either (Either Bool Bool) b)])
forall a a b. a -> (a, [Either a (Either (Either a a) b)])
change Bool
ns
        prep Bool
s (Left BMevents
BMClick) = Bool -> (Bool, [Either Bool (Either (Either Bool Bool) b)])
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, [Bool -> Either Bool (Either (Either Bool Bool) b)
forall a a b b. a -> Either a (Either (Either a b) b)
toPressed Bool
False])
        prep Bool
s (Left BMevents
BMInverted) = (Bool
s, [Bool -> Either Bool (Either (Either Bool Bool) b)
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, [b -> Either Bool (Either (Either Bool Bool) b)
forall b a a. b -> Either a (Either a b)
toFudget b
m])
    in  [(ModState, KeySym)]
-> F (Either BMevents (Either Bool a)) (Either Bool b)
-> F (Either Bool a) (Either Bool b)
forall b c.
[(ModState, KeySym)] -> F (Either BMevents b) c -> F b c
buttonGroupF [(ModState, KeySym)]
keys (F (Either (Either Bool Bool) a) b
-> F (Either Bool (Either (Either Bool Bool) a)) (Either Bool b)
forall c d b. F c d -> F (Either b c) (Either b d)
idLeftF F (Either (Either Bool Bool) a) b
f F (Either Bool (Either (Either Bool Bool) a)) (Either Bool b)
-> SP
     (Either BMevents (Either Bool a))
     (Either Bool (Either (Either Bool Bool) a))
-> F (Either BMevents (Either Bool a)) (Either Bool b)
forall c d e. F c d -> SP e c -> F e d
>=^^< (Bool
 -> Either BMevents (Either Bool a)
 -> (Bool, [Either Bool (Either (Either Bool Bool) a)]))
-> Bool
-> SP
     (Either BMevents (Either Bool a))
     (Either Bool (Either (Either Bool Bool) a))
forall t a b. (t -> a -> (t, [b])) -> t -> SP a b
mapstateSP Bool
-> Either BMevents (Either Bool a)
-> (Bool, [Either Bool (Either (Either Bool Bool) a)])
forall b.
Bool
-> Either BMevents (Either Bool b)
-> (Bool, [Either Bool (Either (Either Bool Bool) b)])
prep Bool
False)