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 b b -> F b (Either b Click)
pushButtonF = Int -> [(ModState, KeySym)] -> F b b -> F b (Either b Click)
forall b b.
Int -> [(ModState, KeySym)] -> F b b -> F b (Either b Click)
pushButtonF' Int
edgeWidth

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