module PushButtonF(pushButtonF, pushButtonF', Click(..)) where
import ButtonBorderF
import ButtonGroupF
import InputMsg(Click(..))
import CompOps((>=^<))
import Defaults(edgeWidth)
--import Fudget
import SerCompF(idRightF)

pushButtonF :: [(ModState, KeySym)] -> F a b -> F a (Either b Click)
pushButtonF = forall {a} {b}.
Int -> [(ModState, KeySym)] -> F a b -> F a (Either b Click)
pushButtonF' Int
edgeWidth

pushButtonF' :: Int -> [(ModState, KeySym)] -> F a b -> F a (Either b Click)
pushButtonF' Int
edgew [(ModState, KeySym)]
keys F a b
f =
    forall {b} {c}.
[(ModState, KeySym)] -> F (Either BMevents b) c -> F b c
buttonGroupF [(ModState, KeySym)]
keys (forall a b c. F a b -> F (Either a c) (Either b c)
idRightF (forall a b. Int -> F a b -> F (Either Bool a) b
buttonBorderF Int
edgew F a b
f) forall c d e. F c d -> (e -> c) -> F e d
>=^< forall {b}. Either BMevents b -> Either (Either Bool b) Click
prep)
  where
    toBorder :: a -> Either (Either a b) b
toBorder = 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
    toFudget :: a -> Either (Either a a) b
toFudget = 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
    through :: b -> Either a b
through = forall a b. b -> Either a b
Right
    prep :: Either BMevents b -> Either (Either Bool b) Click
prep (Left BMevents
BMNormal) = forall {a} {b} {b}. a -> Either (Either a b) b
toBorder Bool
False
    prep (Left BMevents
BMInverted) = forall {a} {b} {b}. a -> Either (Either a b) b
toBorder Bool
True
    prep (Left BMevents
BMClick) = forall {b} {a}. b -> Either a b
through Click
Click
    prep (Right b
e) = forall {a} {a} {b}. a -> Either (Either a a) b
toFudget b
e