-- 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.Lists as Lists
import qualified Util.Rect as Rect
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
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
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
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
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]
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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
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 = forall a. Show a => a -> Text
showt
instance Pretty KbdState where pretty :: KbdState -> Text
pretty = 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 }) -> forall a. Show a => a -> Text
showt MouseState
state
        Kbd KbdState
kstate [Modifier]
mods Key
key Maybe Char
_maybe_char -> forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
            [ forall a b. (a -> b) -> [a] -> [b]
map ((forall a. Semigroup a => a -> a -> a
<>Text
"+") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Text
showt) [Modifier]
mods
            , [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 -> forall a. Show a => a -> Text
showt AuxMsg
msg
        Unhandled Int
x -> Text
"Unhandled: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
x
    UiMsg Context
_ctx (UiUpdate ViewId
vid UiUpdate
update) -> forall a. Ident a => a -> Text
Id.ident_text ViewId
vid forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> 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 = forall a. a -> Maybe a -> a
fromMaybe Text
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
Lists.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
Text.words forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [forall a. Pretty a => a -> Text
pretty MouseEvent
mouse, 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:", forall a. Show a => a -> Text
showt KbdState
kstate, forall a. Show a => a -> Text
showt [Modifier]
mods, forall a. Show a => a -> Text
showt Key
key
                , forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\Char
c -> Text
"(" forall a. Semigroup a => a -> a -> a
<> Char -> Text
Text.singleton Char
c forall a. Semigroup a => a -> a -> a
<> Text
") ") Maybe Char
maybe_char
                    forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty Context
ctx
                ]
            AuxMsg AuxMsg
msg -> [Text] -> Text
Text.unwords [Text
"Aux:", forall a. Show a => a -> Text
showt AuxMsg
msg, forall a. Pretty a => a -> Text
pretty Context
ctx]
            Unhandled Int
x -> Text
"Unhandled: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt Int
x
        UiMsg Context
ctx Msg
msg -> [Text] -> Text
Text.unwords [forall a. Show a => a -> Text
showt Msg
msg, 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:", forall a. Show a => a -> Text
showt MouseState
mstate, forall a. Show a => a -> Text
showt [Modifier]
mods, forall a. Show a => a -> Text
showt (Int, Int)
coords
        , Text
"click:", forall a. Show a => a -> Text
showt Bool
is_click, 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
"{" forall a. Semigroup a => a -> a -> a
<> Text
contents forall a. Semigroup a => a -> a -> a
<> Text
"}"
        where
        contents :: Text
contents = [Text] -> Text
Text.unwords forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
Text.null)
            [ forall {a}. Show a => Text -> Maybe a -> Text
show_maybe Text
"focus" Maybe ViewId
focus
            , forall b a. b -> (a -> b) -> Maybe a -> b
maybe 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=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt a
tnum forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty a
track
        show_maybe :: Text -> Maybe a -> Text
show_maybe Text
desc = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\a
v -> Text
desc forall a. Semigroup a => a -> a -> a
<> Text
"=" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt a
v)

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