-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | Receive events from the C++ UI layer, package them up nicely, and forward
    them on to the event handling mechanism (the responder).
-}
module Ui.UiMsg where
import qualified Data.Text as Text

import qualified Util.Rect as Rect
import qualified Util.Seq as Seq
import qualified Ui.Block as Block
import qualified Ui.Id as Id
import qualified Ui.Key as Key
import qualified Ui.Types as Types

import Global
import Types


-- | Technically not all UiMsgs have a Context, but it's easier to give
-- everyone a Context since it can be all Nothing anyway.
data UiMsg = UiMsg Context Msg
    deriving (Int -> UiMsg -> ShowS
[UiMsg] -> ShowS
UiMsg -> String
(Int -> UiMsg -> ShowS)
-> (UiMsg -> String) -> ([UiMsg] -> ShowS) -> Show UiMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UiMsg] -> ShowS
$cshowList :: [UiMsg] -> ShowS
show :: UiMsg -> String
$cshow :: UiMsg -> String
showsPrec :: Int -> UiMsg -> ShowS
$cshowsPrec :: Int -> UiMsg -> ShowS
Show)

data Context = Context
    { Context -> Maybe ViewId
ctx_focus :: Maybe ViewId
    -- | Index into block tracks.  The TrackNum will be one greater than the
    -- last track if the cursor has moved beyond it.
    , Context -> Maybe (Int, Track)
ctx_track :: Maybe (TrackNum, Track)
    -- | Indicates that the msg originated from the floating input.
    -- It should be an 'UpdateInput'.
    , Context -> Bool
ctx_floating_input :: !Bool
    } deriving (Int -> Context -> ShowS
[Context] -> ShowS
Context -> String
(Int -> Context -> ShowS)
-> (Context -> String) -> ([Context] -> ShowS) -> Show Context
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Context] -> ShowS
$cshowList :: [Context] -> ShowS
show :: Context -> String
$cshow :: Context -> String
showsPrec :: Int -> Context -> ShowS
$cshowsPrec :: Int -> Context -> ShowS
Show)

-- | Whether the context is on the track itself or the skeleton display above
-- the track.
--
-- There are a few cases where there is a track but no position and it
-- *doesn't* mean SkeletonDisplay, namely UpdateTrackWidth and UpdateInput.
-- However, those cases are handled in a specific place while Track goes on
-- to become a mouse Modifier, so I don't mind if the former is a little
-- awkward for the benefit of the latter.
data Track = Track !TrackTime | SkeletonDisplay | Divider
    deriving (Track -> Track -> Bool
(Track -> Track -> Bool) -> (Track -> Track -> Bool) -> Eq Track
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Track -> Track -> Bool
$c/= :: Track -> Track -> Bool
== :: Track -> Track -> Bool
$c== :: Track -> Track -> Bool
Eq, Eq Track
Eq Track
-> (Track -> Track -> Ordering)
-> (Track -> Track -> Bool)
-> (Track -> Track -> Bool)
-> (Track -> Track -> Bool)
-> (Track -> Track -> Bool)
-> (Track -> Track -> Track)
-> (Track -> Track -> Track)
-> Ord Track
Track -> Track -> Bool
Track -> Track -> Ordering
Track -> Track -> Track
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 :: Track -> Track -> Track
$cmin :: Track -> Track -> Track
max :: Track -> Track -> Track
$cmax :: Track -> Track -> Track
>= :: Track -> Track -> Bool
$c>= :: Track -> Track -> Bool
> :: Track -> Track -> Bool
$c> :: Track -> Track -> Bool
<= :: Track -> Track -> Bool
$c<= :: Track -> Track -> Bool
< :: Track -> Track -> Bool
$c< :: Track -> Track -> Bool
compare :: Track -> Track -> Ordering
$ccompare :: Track -> Track -> Ordering
Ord, ReadPrec [Track]
ReadPrec Track
Int -> ReadS Track
ReadS [Track]
(Int -> ReadS Track)
-> ReadS [Track]
-> ReadPrec Track
-> ReadPrec [Track]
-> Read Track
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Track]
$creadListPrec :: ReadPrec [Track]
readPrec :: ReadPrec Track
$creadPrec :: ReadPrec Track
readList :: ReadS [Track]
$creadList :: ReadS [Track]
readsPrec :: Int -> ReadS Track
$creadsPrec :: Int -> ReadS Track
Read, Int -> Track -> ShowS
[Track] -> ShowS
Track -> String
(Int -> Track -> ShowS)
-> (Track -> String) -> ([Track] -> ShowS) -> Show Track
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Track] -> ShowS
$cshowList :: [Track] -> ShowS
show :: Track -> String
$cshow :: Track -> String
showsPrec :: Int -> Track -> ShowS
$cshowsPrec :: Int -> Track -> ShowS
Show)
    -- (Eq, Ord, Read) needed because this is in Cmd.Modifier

-- | Corresponds to UiMsg::MsgType enum.
--
-- Each UiUpdate has a ViewId which is separate from the focus.  This is
-- because they can happen to an unfocused view, e.g. on OS X UpdateViewResize
-- and UpdateClose.
data Msg =
    MsgEvent MsgEvent
    | UiUpdate ViewId UiUpdate
    -- | Give screen dimensions: screen number, total screens, rect.  This
    -- is a UiUpdate but it doesn't have a ViewId.
    | UpdateScreenSize Int Int Rect.Rect
    deriving (Msg -> Msg -> Bool
(Msg -> Msg -> Bool) -> (Msg -> Msg -> Bool) -> Eq Msg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Msg -> Msg -> Bool
$c/= :: Msg -> Msg -> Bool
== :: Msg -> Msg -> Bool
$c== :: Msg -> Msg -> Bool
Eq, Eq Msg
Eq Msg
-> (Msg -> Msg -> Ordering)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Bool)
-> (Msg -> Msg -> Msg)
-> (Msg -> Msg -> Msg)
-> Ord Msg
Msg -> Msg -> Bool
Msg -> Msg -> Ordering
Msg -> Msg -> Msg
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 :: Msg -> Msg -> Msg
$cmin :: Msg -> Msg -> Msg
max :: Msg -> Msg -> Msg
$cmax :: Msg -> Msg -> Msg
>= :: Msg -> Msg -> Bool
$c>= :: Msg -> Msg -> Bool
> :: Msg -> Msg -> Bool
$c> :: Msg -> Msg -> Bool
<= :: Msg -> Msg -> Bool
$c<= :: Msg -> Msg -> Bool
< :: Msg -> Msg -> Bool
$c< :: Msg -> Msg -> Bool
compare :: Msg -> Msg -> Ordering
$ccompare :: Msg -> Msg -> Ordering
Ord, Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
(Int -> Msg -> ShowS)
-> (Msg -> String) -> ([Msg] -> ShowS) -> Show Msg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Msg] -> ShowS
$cshowList :: [Msg] -> ShowS
show :: Msg -> String
$cshow :: Msg -> String
showsPrec :: Int -> Msg -> ShowS
$cshowsPrec :: Int -> Msg -> ShowS
Show)

-- | These are generated when the UI is manipulated directly and makes changes
-- to its own state.  They are like Ui.Update except in the opposide
-- direction: fltk telling haskell what changes occurred.
data UiUpdate =
    -- | Nothing means the text didn't change, but a msg is being sent anyway
    -- since that's the only way I know the floating edit input has closed.
    UpdateInput !(Maybe Text.Text)
    | UpdateTrackScroll !Types.Width
    | UpdateTimeScroll !ScoreTime
    -- | Size of entire block window, and padding.
    | UpdateViewResize !Rect.Rect !Block.Padding
    -- | TrackWidth.width, TrackWidth.suggested_width
    | UpdateTrackWidth !Types.Width !Types.Width
    -- | The given view was closed.
    | UpdateClose
    deriving (UiUpdate -> UiUpdate -> Bool
(UiUpdate -> UiUpdate -> Bool)
-> (UiUpdate -> UiUpdate -> Bool) -> Eq UiUpdate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UiUpdate -> UiUpdate -> Bool
$c/= :: UiUpdate -> UiUpdate -> Bool
== :: UiUpdate -> UiUpdate -> Bool
$c== :: UiUpdate -> UiUpdate -> Bool
Eq, Eq UiUpdate
Eq UiUpdate
-> (UiUpdate -> UiUpdate -> Ordering)
-> (UiUpdate -> UiUpdate -> Bool)
-> (UiUpdate -> UiUpdate -> Bool)
-> (UiUpdate -> UiUpdate -> Bool)
-> (UiUpdate -> UiUpdate -> Bool)
-> (UiUpdate -> UiUpdate -> UiUpdate)
-> (UiUpdate -> UiUpdate -> UiUpdate)
-> Ord UiUpdate
UiUpdate -> UiUpdate -> Bool
UiUpdate -> UiUpdate -> Ordering
UiUpdate -> UiUpdate -> UiUpdate
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 :: UiUpdate -> UiUpdate -> UiUpdate
$cmin :: UiUpdate -> UiUpdate -> UiUpdate
max :: UiUpdate -> UiUpdate -> UiUpdate
$cmax :: UiUpdate -> UiUpdate -> UiUpdate
>= :: UiUpdate -> UiUpdate -> Bool
$c>= :: UiUpdate -> UiUpdate -> Bool
> :: UiUpdate -> UiUpdate -> Bool
$c> :: UiUpdate -> UiUpdate -> Bool
<= :: UiUpdate -> UiUpdate -> Bool
$c<= :: UiUpdate -> UiUpdate -> Bool
< :: UiUpdate -> UiUpdate -> Bool
$c< :: UiUpdate -> UiUpdate -> Bool
compare :: UiUpdate -> UiUpdate -> Ordering
$ccompare :: UiUpdate -> UiUpdate -> Ordering
Ord, Int -> UiUpdate -> ShowS
[UiUpdate] -> ShowS
UiUpdate -> String
(Int -> UiUpdate -> ShowS)
-> (UiUpdate -> String) -> ([UiUpdate] -> ShowS) -> Show UiUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UiUpdate] -> ShowS
$cshowList :: [UiUpdate] -> ShowS
show :: UiUpdate -> String
$cshow :: UiUpdate -> String
showsPrec :: Int -> UiUpdate -> ShowS
$cshowsPrec :: Int -> UiUpdate -> ShowS
Show)

-- | MsgType.msg_event, which is a fltk event.
data MsgEvent =
    Mouse !MouseEvent
    -- | The Char is the text that this key wants to enter, if any.  The Key is
    -- just the keycap, without taking shift or other modifiers into account.
    | Kbd KbdState [Key.Modifier] Key.Key (Maybe Char)
    | AuxMsg AuxMsg
    | Unhandled Int
    deriving (MsgEvent -> MsgEvent -> Bool
(MsgEvent -> MsgEvent -> Bool)
-> (MsgEvent -> MsgEvent -> Bool) -> Eq MsgEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MsgEvent -> MsgEvent -> Bool
$c/= :: MsgEvent -> MsgEvent -> Bool
== :: MsgEvent -> MsgEvent -> Bool
$c== :: MsgEvent -> MsgEvent -> Bool
Eq, Eq MsgEvent
Eq MsgEvent
-> (MsgEvent -> MsgEvent -> Ordering)
-> (MsgEvent -> MsgEvent -> Bool)
-> (MsgEvent -> MsgEvent -> Bool)
-> (MsgEvent -> MsgEvent -> Bool)
-> (MsgEvent -> MsgEvent -> Bool)
-> (MsgEvent -> MsgEvent -> MsgEvent)
-> (MsgEvent -> MsgEvent -> MsgEvent)
-> Ord MsgEvent
MsgEvent -> MsgEvent -> Bool
MsgEvent -> MsgEvent -> Ordering
MsgEvent -> MsgEvent -> MsgEvent
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 :: MsgEvent -> MsgEvent -> MsgEvent
$cmin :: MsgEvent -> MsgEvent -> MsgEvent
max :: MsgEvent -> MsgEvent -> MsgEvent
$cmax :: MsgEvent -> MsgEvent -> MsgEvent
>= :: MsgEvent -> MsgEvent -> Bool
$c>= :: MsgEvent -> MsgEvent -> Bool
> :: MsgEvent -> MsgEvent -> Bool
$c> :: MsgEvent -> MsgEvent -> Bool
<= :: MsgEvent -> MsgEvent -> Bool
$c<= :: MsgEvent -> MsgEvent -> Bool
< :: MsgEvent -> MsgEvent -> Bool
$c< :: MsgEvent -> MsgEvent -> Bool
compare :: MsgEvent -> MsgEvent -> Ordering
$ccompare :: MsgEvent -> MsgEvent -> Ordering
Ord, Int -> MsgEvent -> ShowS
[MsgEvent] -> ShowS
MsgEvent -> String
(Int -> MsgEvent -> ShowS)
-> (MsgEvent -> String) -> ([MsgEvent] -> ShowS) -> Show MsgEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MsgEvent] -> ShowS
$cshowList :: [MsgEvent] -> ShowS
show :: MsgEvent -> String
$cshow :: MsgEvent -> String
showsPrec :: Int -> MsgEvent -> ShowS
$cshowsPrec :: Int -> MsgEvent -> ShowS
Show)
    -- The presence of [Key.Modifier] in Kbd and Mouse is ugly because it's
    -- only for cmd_record_keys.  All the rest should use Cmd.state_keys_down.
    -- TODO maybe this should move to MsgEvent so FOCUS can update the
    -- modifiers?  Doesn't matter as long as fltk doesn't support it.

data MouseEvent = MouseEvent
    { MouseEvent -> MouseState
mouse_state :: !MouseState
    , MouseEvent -> [Modifier]
mouse_modifiers :: ![Key.Modifier]
    , MouseEvent -> (Int, Int)
mouse_coords :: !(Int, Int)
    -- | As per fltk, 0 is the first click, 1 is a double click, etc.
    , MouseEvent -> Int
mouse_clicks :: !Int
    , MouseEvent -> Bool
mouse_is_click :: !Bool
    } deriving (MouseEvent -> MouseEvent -> Bool
(MouseEvent -> MouseEvent -> Bool)
-> (MouseEvent -> MouseEvent -> Bool) -> Eq MouseEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseEvent -> MouseEvent -> Bool
$c/= :: MouseEvent -> MouseEvent -> Bool
== :: MouseEvent -> MouseEvent -> Bool
$c== :: MouseEvent -> MouseEvent -> Bool
Eq, Eq MouseEvent
Eq MouseEvent
-> (MouseEvent -> MouseEvent -> Ordering)
-> (MouseEvent -> MouseEvent -> Bool)
-> (MouseEvent -> MouseEvent -> Bool)
-> (MouseEvent -> MouseEvent -> Bool)
-> (MouseEvent -> MouseEvent -> Bool)
-> (MouseEvent -> MouseEvent -> MouseEvent)
-> (MouseEvent -> MouseEvent -> MouseEvent)
-> Ord MouseEvent
MouseEvent -> MouseEvent -> Bool
MouseEvent -> MouseEvent -> Ordering
MouseEvent -> MouseEvent -> MouseEvent
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 :: MouseEvent -> MouseEvent -> MouseEvent
$cmin :: MouseEvent -> MouseEvent -> MouseEvent
max :: MouseEvent -> MouseEvent -> MouseEvent
$cmax :: MouseEvent -> MouseEvent -> MouseEvent
>= :: MouseEvent -> MouseEvent -> Bool
$c>= :: MouseEvent -> MouseEvent -> Bool
> :: MouseEvent -> MouseEvent -> Bool
$c> :: MouseEvent -> MouseEvent -> Bool
<= :: MouseEvent -> MouseEvent -> Bool
$c<= :: MouseEvent -> MouseEvent -> Bool
< :: MouseEvent -> MouseEvent -> Bool
$c< :: MouseEvent -> MouseEvent -> Bool
compare :: MouseEvent -> MouseEvent -> Ordering
$ccompare :: MouseEvent -> MouseEvent -> Ordering
Ord, Int -> MouseEvent -> ShowS
[MouseEvent] -> ShowS
MouseEvent -> String
(Int -> MouseEvent -> ShowS)
-> (MouseEvent -> String)
-> ([MouseEvent] -> ShowS)
-> Show MouseEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseEvent] -> ShowS
$cshowList :: [MouseEvent] -> ShowS
show :: MouseEvent -> String
$cshow :: MouseEvent -> String
showsPrec :: Int -> MouseEvent -> ShowS
$cshowsPrec :: Int -> MouseEvent -> ShowS
Show)

-- | Most of these are unused, but are included here for completeness.
data AuxMsg = Enter | Leave | Focus | Unfocus | Shortcut | Deactivate
    | Activate | Hide | Show
    deriving (AuxMsg -> AuxMsg -> Bool
(AuxMsg -> AuxMsg -> Bool)
-> (AuxMsg -> AuxMsg -> Bool) -> Eq AuxMsg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuxMsg -> AuxMsg -> Bool
$c/= :: AuxMsg -> AuxMsg -> Bool
== :: AuxMsg -> AuxMsg -> Bool
$c== :: AuxMsg -> AuxMsg -> Bool
Eq, Eq AuxMsg
Eq AuxMsg
-> (AuxMsg -> AuxMsg -> Ordering)
-> (AuxMsg -> AuxMsg -> Bool)
-> (AuxMsg -> AuxMsg -> Bool)
-> (AuxMsg -> AuxMsg -> Bool)
-> (AuxMsg -> AuxMsg -> Bool)
-> (AuxMsg -> AuxMsg -> AuxMsg)
-> (AuxMsg -> AuxMsg -> AuxMsg)
-> Ord AuxMsg
AuxMsg -> AuxMsg -> Bool
AuxMsg -> AuxMsg -> Ordering
AuxMsg -> AuxMsg -> AuxMsg
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 :: AuxMsg -> AuxMsg -> AuxMsg
$cmin :: AuxMsg -> AuxMsg -> AuxMsg
max :: AuxMsg -> AuxMsg -> AuxMsg
$cmax :: AuxMsg -> AuxMsg -> AuxMsg
>= :: AuxMsg -> AuxMsg -> Bool
$c>= :: AuxMsg -> AuxMsg -> Bool
> :: AuxMsg -> AuxMsg -> Bool
$c> :: AuxMsg -> AuxMsg -> Bool
<= :: AuxMsg -> AuxMsg -> Bool
$c<= :: AuxMsg -> AuxMsg -> Bool
< :: AuxMsg -> AuxMsg -> Bool
$c< :: AuxMsg -> AuxMsg -> Bool
compare :: AuxMsg -> AuxMsg -> Ordering
$ccompare :: AuxMsg -> AuxMsg -> Ordering
Ord, Int -> AuxMsg -> ShowS
[AuxMsg] -> ShowS
AuxMsg -> String
(Int -> AuxMsg -> ShowS)
-> (AuxMsg -> String) -> ([AuxMsg] -> ShowS) -> Show AuxMsg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AuxMsg] -> ShowS
$cshowList :: [AuxMsg] -> ShowS
show :: AuxMsg -> String
$cshow :: AuxMsg -> String
showsPrec :: Int -> AuxMsg -> ShowS
$cshowsPrec :: Int -> AuxMsg -> ShowS
Show)

data MouseState = MouseMove | MouseDrag Types.MouseButton
    | MouseDown Types.MouseButton | MouseUp Types.MouseButton
    deriving (MouseState -> MouseState -> Bool
(MouseState -> MouseState -> Bool)
-> (MouseState -> MouseState -> Bool) -> Eq MouseState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MouseState -> MouseState -> Bool
$c/= :: MouseState -> MouseState -> Bool
== :: MouseState -> MouseState -> Bool
$c== :: MouseState -> MouseState -> Bool
Eq, Eq MouseState
Eq MouseState
-> (MouseState -> MouseState -> Ordering)
-> (MouseState -> MouseState -> Bool)
-> (MouseState -> MouseState -> Bool)
-> (MouseState -> MouseState -> Bool)
-> (MouseState -> MouseState -> Bool)
-> (MouseState -> MouseState -> MouseState)
-> (MouseState -> MouseState -> MouseState)
-> Ord MouseState
MouseState -> MouseState -> Bool
MouseState -> MouseState -> Ordering
MouseState -> MouseState -> MouseState
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 :: MouseState -> MouseState -> MouseState
$cmin :: MouseState -> MouseState -> MouseState
max :: MouseState -> MouseState -> MouseState
$cmax :: MouseState -> MouseState -> MouseState
>= :: MouseState -> MouseState -> Bool
$c>= :: MouseState -> MouseState -> Bool
> :: MouseState -> MouseState -> Bool
$c> :: MouseState -> MouseState -> Bool
<= :: MouseState -> MouseState -> Bool
$c<= :: MouseState -> MouseState -> Bool
< :: MouseState -> MouseState -> Bool
$c< :: MouseState -> MouseState -> Bool
compare :: MouseState -> MouseState -> Ordering
$ccompare :: MouseState -> MouseState -> Ordering
Ord, Int -> MouseState -> ShowS
[MouseState] -> ShowS
MouseState -> String
(Int -> MouseState -> ShowS)
-> (MouseState -> String)
-> ([MouseState] -> ShowS)
-> Show MouseState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MouseState] -> ShowS
$cshowList :: [MouseState] -> ShowS
show :: MouseState -> String
$cshow :: MouseState -> String
showsPrec :: Int -> MouseState -> ShowS
$cshowsPrec :: Int -> MouseState -> ShowS
Show)
data KbdState = KeyDown | KeyRepeat | KeyUp deriving (KbdState -> KbdState -> Bool
(KbdState -> KbdState -> Bool)
-> (KbdState -> KbdState -> Bool) -> Eq KbdState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KbdState -> KbdState -> Bool
$c/= :: KbdState -> KbdState -> Bool
== :: KbdState -> KbdState -> Bool
$c== :: KbdState -> KbdState -> Bool
Eq, Eq KbdState
Eq KbdState
-> (KbdState -> KbdState -> Ordering)
-> (KbdState -> KbdState -> Bool)
-> (KbdState -> KbdState -> Bool)
-> (KbdState -> KbdState -> Bool)
-> (KbdState -> KbdState -> Bool)
-> (KbdState -> KbdState -> KbdState)
-> (KbdState -> KbdState -> KbdState)
-> Ord KbdState
KbdState -> KbdState -> Bool
KbdState -> KbdState -> Ordering
KbdState -> KbdState -> KbdState
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 :: KbdState -> KbdState -> KbdState
$cmin :: KbdState -> KbdState -> KbdState
max :: KbdState -> KbdState -> KbdState
$cmax :: KbdState -> KbdState -> KbdState
>= :: KbdState -> KbdState -> Bool
$c>= :: KbdState -> KbdState -> Bool
> :: KbdState -> KbdState -> Bool
$c> :: KbdState -> KbdState -> Bool
<= :: KbdState -> KbdState -> Bool
$c<= :: KbdState -> KbdState -> Bool
< :: KbdState -> KbdState -> Bool
$c< :: KbdState -> KbdState -> Bool
compare :: KbdState -> KbdState -> Ordering
$ccompare :: KbdState -> KbdState -> Ordering
Ord, Int -> KbdState -> ShowS
[KbdState] -> ShowS
KbdState -> String
(Int -> KbdState -> ShowS)
-> (KbdState -> String) -> ([KbdState] -> ShowS) -> Show KbdState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KbdState] -> ShowS
$cshowList :: [KbdState] -> ShowS
show :: KbdState -> String
$cshow :: KbdState -> String
showsPrec :: Int -> KbdState -> ShowS
$cshowsPrec :: Int -> KbdState -> ShowS
Show)

instance Pretty MouseState where pretty :: MouseState -> Text
pretty = MouseState -> Text
forall a. Show a => a -> Text
showt
instance Pretty KbdState where pretty :: KbdState -> Text
pretty = KbdState -> Text
forall a. Show a => a -> Text
showt

-- | Like 'pretty', but more compact.  Only show the most important bits.
show_short :: UiMsg -> Text
show_short :: UiMsg -> Text
show_short = \case
    UiMsg Context
_ctx (MsgEvent MsgEvent
mdata) -> case MsgEvent
mdata of
        Mouse (MouseEvent { mouse_state :: MouseEvent -> MouseState
mouse_state = MouseState
state }) -> MouseState -> Text
forall a. Show a => a -> Text
showt MouseState
state
        Kbd KbdState
kstate [Modifier]
mods Key
key Maybe Char
_maybe_char -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [[Text]] -> [Text]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ (Modifier -> Text) -> [Modifier] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>Text
"+") (Text -> Text) -> (Modifier -> Text) -> Modifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Modifier -> Text
forall a. Show a => a -> Text
showt) [Modifier]
mods
            , [Key -> Text
forall a. Pretty a => a -> Text
pretty Key
key]
            , case KbdState
kstate of
                KbdState
KeyDown -> []
                KbdState
KeyUp -> [Text
"(u)"]
                KbdState
KeyRepeat -> [Text
"(r)"]
            ]
        AuxMsg AuxMsg
msg -> AuxMsg -> Text
forall a. Show a => a -> Text
showt AuxMsg
msg
        Unhandled Int
x -> Text
"Unhandled: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
x
    UiMsg Context
_ctx (UiUpdate ViewId
vid UiUpdate
update) -> ViewId -> Text
forall a. Ident a => a -> Text
Id.ident_text ViewId
vid Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> UiUpdate -> Text
forall a. Show a => a -> Text
word UiUpdate
update
    UiMsg Context
_ctx (UpdateScreenSize {}) -> Text
"UpdateScreenSize"
    where
    word :: Show a => a -> Text
    word :: forall a. Show a => a -> Text
word = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Maybe Text -> Text) -> (a -> Maybe Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Maybe Text
forall a. [a] -> Maybe a
Seq.head ([Text] -> Maybe Text) -> (a -> [Text]) -> a -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words (Text -> [Text]) -> (a -> Text) -> a -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Text
forall a. Show a => a -> Text
showt

instance Pretty UiMsg where
    pretty :: UiMsg -> Text
pretty UiMsg
ui_msg = case UiMsg
ui_msg of
        UiMsg Context
ctx (MsgEvent MsgEvent
mdata) -> case MsgEvent
mdata of
            Mouse MouseEvent
mouse -> [Text] -> Text
Text.unwords [MouseEvent -> Text
forall a. Pretty a => a -> Text
pretty MouseEvent
mouse, Context -> Text
forall a. Pretty a => a -> Text
pretty Context
ctx]
            Kbd KbdState
kstate [Modifier]
mods Key
key Maybe Char
maybe_char -> [Text] -> Text
Text.unwords
                [ Text
"Kbd:", KbdState -> Text
forall a. Show a => a -> Text
showt KbdState
kstate, [Modifier] -> Text
forall a. Show a => a -> Text
showt [Modifier]
mods, Key -> Text
forall a. Show a => a -> Text
showt Key
key
                , Text -> (Char -> Text) -> Maybe Char -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Char
c -> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
") ") Maybe Char
maybe_char
                    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Context -> Text
forall a. Pretty a => a -> Text
pretty Context
ctx
                ]
            AuxMsg AuxMsg
msg -> [Text] -> Text
Text.unwords [Text
"Aux:", AuxMsg -> Text
forall a. Show a => a -> Text
showt AuxMsg
msg, Context -> Text
forall a. Pretty a => a -> Text
pretty Context
ctx]
            Unhandled Int
x -> Text
"Unhandled: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
showt Int
x
        UiMsg Context
ctx Msg
msg -> [Text] -> Text
Text.unwords [Msg -> Text
forall a. Show a => a -> Text
showt Msg
msg, Context -> Text
forall a. Pretty a => a -> Text
pretty Context
ctx]

instance Pretty MouseEvent where
    pretty :: MouseEvent -> Text
pretty (MouseEvent MouseState
mstate [Modifier]
mods (Int, Int)
coords Int
clicks Bool
is_click) = [Text] -> Text
Text.unwords
        [ Text
"Mouse:", MouseState -> Text
forall a. Show a => a -> Text
showt MouseState
mstate, [Modifier] -> Text
forall a. Show a => a -> Text
showt [Modifier]
mods, (Int, Int) -> Text
forall a. Show a => a -> Text
showt (Int, Int)
coords
        , Text
"click:", Bool -> Text
forall a. Show a => a -> Text
showt Bool
is_click, Int -> Text
forall a. Show a => a -> Text
showt Int
clicks
        ]

instance Pretty Context where
    pretty :: Context -> Text
pretty (Context Maybe ViewId
focus Maybe (Int, Track)
track Bool
floating_input) = Text
"{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
contents Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"
        where
        contents :: Text
contents = [Text] -> Text
Text.unwords ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
            [ Text -> Maybe ViewId -> Text
forall {a}. Show a => Text -> Maybe a -> Text
show_maybe Text
"focus" Maybe ViewId
focus
            , Text -> ((Int, Track) -> Text) -> Maybe (Int, Track) -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (Int, Track) -> Text
forall {a} {a}. (Show a, Pretty a) => (a, a) -> Text
show_track Maybe (Int, Track)
track
            , if Bool
floating_input then Text
"floating_input" else Text
""
            ]
        show_track :: (a, a) -> Text
show_track (a
tnum, a
track) =
            Text
"track=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showt a
tnum Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Pretty a => a -> Text
pretty a
track
        show_maybe :: Text -> Maybe a -> Text
show_maybe Text
desc = Text -> (a -> Text) -> Maybe a -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\a
v -> Text
desc Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall a. Show a => a -> Text
showt a
v)

instance Pretty Track where
    pretty :: Track -> Text
pretty (Track TrackTime
pos) = Text
"track:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TrackTime -> Text
forall a. Pretty a => a -> Text
pretty TrackTime
pos
    pretty Track
Divider = Text
"div"
    pretty Track
SkeletonDisplay = Text
"skel"