-- | Types for messages from buttons and input fields
module InputMsg where
import AuxTypes(KeySym(..))

-- | Button clicks
data Click = Click  deriving (Click -> Click -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Click -> Click -> Bool
$c/= :: Click -> Click -> Bool
== :: Click -> Click -> Bool
$c== :: Click -> Click -> Bool
Eq, Eq Click
Click -> Click -> Bool
Click -> Click -> Ordering
Click -> Click -> Click
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Click -> Click -> Click
$cmin :: Click -> Click -> Click
max :: Click -> Click -> Click
$cmax :: Click -> Click -> Click
>= :: Click -> Click -> Bool
$c>= :: Click -> Click -> Bool
> :: Click -> Click -> Bool
$c> :: Click -> Click -> Bool
<= :: Click -> Click -> Bool
$c<= :: Click -> Click -> Bool
< :: Click -> Click -> Bool
$c< :: Click -> Click -> Bool
compare :: Click -> Click -> Ordering
$ccompare :: Click -> Click -> Ordering
Ord, Int -> Click -> ShowS
[Click] -> ShowS
Click -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Click] -> ShowS
$cshowList :: [Click] -> ShowS
show :: Click -> String
$cshow :: Click -> String
showsPrec :: Int -> Click -> ShowS
$cshowsPrec :: Int -> Click -> ShowS
Show)

-- | Output from dialog popups with OK and Cancel buttons
data ConfirmMsg = Confirm | Cancel  deriving (ConfirmMsg -> ConfirmMsg -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfirmMsg -> ConfirmMsg -> Bool
$c/= :: ConfirmMsg -> ConfirmMsg -> Bool
== :: ConfirmMsg -> ConfirmMsg -> Bool
$c== :: ConfirmMsg -> ConfirmMsg -> Bool
Eq, Eq ConfirmMsg
ConfirmMsg -> ConfirmMsg -> Bool
ConfirmMsg -> ConfirmMsg -> Ordering
ConfirmMsg -> ConfirmMsg -> ConfirmMsg
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ConfirmMsg -> ConfirmMsg -> ConfirmMsg
$cmin :: ConfirmMsg -> ConfirmMsg -> ConfirmMsg
max :: ConfirmMsg -> ConfirmMsg -> ConfirmMsg
$cmax :: ConfirmMsg -> ConfirmMsg -> ConfirmMsg
>= :: ConfirmMsg -> ConfirmMsg -> Bool
$c>= :: ConfirmMsg -> ConfirmMsg -> Bool
> :: ConfirmMsg -> ConfirmMsg -> Bool
$c> :: ConfirmMsg -> ConfirmMsg -> Bool
<= :: ConfirmMsg -> ConfirmMsg -> Bool
$c<= :: ConfirmMsg -> ConfirmMsg -> Bool
< :: ConfirmMsg -> ConfirmMsg -> Bool
$c< :: ConfirmMsg -> ConfirmMsg -> Bool
compare :: ConfirmMsg -> ConfirmMsg -> Ordering
$ccompare :: ConfirmMsg -> ConfirmMsg -> Ordering
Ord, Int -> ConfirmMsg -> ShowS
[ConfirmMsg] -> ShowS
ConfirmMsg -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfirmMsg] -> ShowS
$cshowList :: [ConfirmMsg] -> ShowS
show :: ConfirmMsg -> String
$cshow :: ConfirmMsg -> String
showsPrec :: Int -> ConfirmMsg -> ShowS
$cshowsPrec :: Int -> ConfirmMsg -> ShowS
Show)

toConfirm :: Either a b -> ConfirmMsg
toConfirm (Left a
_)  = ConfirmMsg
Confirm
toConfirm (Right b
_) = ConfirmMsg
Cancel
fromConfirm :: ConfirmMsg -> Either Click Click
fromConfirm ConfirmMsg
Confirm = forall a b. a -> Either a b
Left Click
Click
fromConfirm ConfirmMsg
Cancel  = forall a b. b -> Either a b
Right Click
Click

data InputMsg a = InputChange a |
                  InputDone KeySym a 
                  deriving (InputMsg a -> InputMsg a -> Bool
forall a. Eq a => InputMsg a -> InputMsg a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputMsg a -> InputMsg a -> Bool
$c/= :: forall a. Eq a => InputMsg a -> InputMsg a -> Bool
== :: InputMsg a -> InputMsg a -> Bool
$c== :: forall a. Eq a => InputMsg a -> InputMsg a -> Bool
Eq, InputMsg a -> InputMsg a -> Bool
InputMsg a -> InputMsg a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (InputMsg a)
forall a. Ord a => InputMsg a -> InputMsg a -> Bool
forall a. Ord a => InputMsg a -> InputMsg a -> Ordering
forall a. Ord a => InputMsg a -> InputMsg a -> InputMsg a
min :: InputMsg a -> InputMsg a -> InputMsg a
$cmin :: forall a. Ord a => InputMsg a -> InputMsg a -> InputMsg a
max :: InputMsg a -> InputMsg a -> InputMsg a
$cmax :: forall a. Ord a => InputMsg a -> InputMsg a -> InputMsg a
>= :: InputMsg a -> InputMsg a -> Bool
$c>= :: forall a. Ord a => InputMsg a -> InputMsg a -> Bool
> :: InputMsg a -> InputMsg a -> Bool
$c> :: forall a. Ord a => InputMsg a -> InputMsg a -> Bool
<= :: InputMsg a -> InputMsg a -> Bool
$c<= :: forall a. Ord a => InputMsg a -> InputMsg a -> Bool
< :: InputMsg a -> InputMsg a -> Bool
$c< :: forall a. Ord a => InputMsg a -> InputMsg a -> Bool
compare :: InputMsg a -> InputMsg a -> Ordering
$ccompare :: forall a. Ord a => InputMsg a -> InputMsg a -> Ordering
Ord, Int -> InputMsg a -> ShowS
forall a. Show a => Int -> InputMsg a -> ShowS
forall a. Show a => [InputMsg a] -> ShowS
forall a. Show a => InputMsg a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InputMsg a] -> ShowS
$cshowList :: forall a. Show a => [InputMsg a] -> ShowS
show :: InputMsg a -> String
$cshow :: forall a. Show a => InputMsg a -> String
showsPrec :: Int -> InputMsg a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> InputMsg a -> ShowS
Show)

inputMsg :: a -> InputMsg a
inputMsg = forall a. String -> a -> InputMsg a
InputDone String
inputButtonKey
inputChange :: a -> InputMsg a
inputChange = forall a. a -> InputMsg a
InputChange

inputButtonKey :: String
inputButtonKey = String
"." :: KeySym
inputLeaveKey :: String
inputLeaveKey  = String
""  :: KeySym

stripInputMsg :: InputMsg a -> a
stripInputMsg (InputDone String
_ a
x) = a
x
stripInputMsg (InputChange a
x) = a
x

tstInp :: (t -> t) -> InputMsg t -> t
tstInp t -> t
p (InputChange t
s) = t -> t
p t
s
tstInp t -> t
p (InputDone String
k t
s) = t -> t
p t
s

mapInp :: (t -> a) -> InputMsg t -> InputMsg a
mapInp t -> a
f (InputChange t
s) = forall a. a -> InputMsg a
InputChange (t -> a
f t
s)
mapInp t -> a
f (InputDone String
k t
s) = forall a. String -> a -> InputMsg a
InputDone String
k (t -> a
f t
s)

instance Functor InputMsg where fmap :: forall a b. (a -> b) -> InputMsg a -> InputMsg b
fmap = forall a b. (a -> b) -> InputMsg a -> InputMsg b
mapInp

inputDone :: InputMsg a -> Maybe a
inputDone (InputDone String
k a
s) | String
k forall a. Eq a => a -> a -> Bool
/= String
inputLeaveKey = forall a. a -> Maybe a
Just a
s
inputDone InputMsg a
_ = forall a. Maybe a
Nothing

inputLeaveDone :: InputMsg a -> Maybe a
inputLeaveDone (InputDone String
_ a
s) = forall a. a -> Maybe a
Just a
s
inputLeaveDone InputMsg a
_ = forall a. Maybe a
Nothing