    {-# LANGUAGE CPP #-}

    module Termonad.Term where

    import Termonad.Prelude

    import Control.Lens ((^.), (.~), set, to)
    import Data.Colour.SRGB (Colour, RGB(RGB), toSRGB)
    import Data.FocusList (appendFL, deleteFL, getFocusItemFL)
    import GI.Gdk
      ( Event (Event)
      , EventButton
      , EventKey
      , RGBA
      , getEventButtonButton
      , newZeroRGBA
      , setRGBABlue
      , setRGBAGreen
      , setRGBARed
      , pattern BUTTON_SECONDARY
      , pattern CURRENT_TIME
      )
    import GI.Gio
      ( Cancellable
      , actionMapAddAction
      , menuAppend
      , menuNew
      , onSimpleActionActivate
      , simpleActionNew
      )
    import GI.GLib
      ( SpawnFlags(SpawnFlagsDefault)
      )
    import GI.Gtk
      ( Adjustment
      , Align(AlignFill)
      , ApplicationWindow
      , Box
      , Button
      , IconSize(IconSizeMenu)
      , Label
      , Notebook
      , Orientation(OrientationHorizontal)
      , PolicyType(PolicyTypeAlways, PolicyTypeAutomatic, PolicyTypeNever)
      , ReliefStyle(ReliefStyleNone)
      , ResponseType(ResponseTypeNo, ResponseTypeYes)
      , ScrolledWindow
      , Window
      , applicationGetActiveWindow
      , boxNew
      , buttonNewFromIconName
      , buttonSetRelief
      , containerAdd
      , dialogAddButton
      , dialogGetContentArea
      , dialogNew
      , dialogRun
      , labelNew
      , labelSetEllipsize
      , labelSetLabel
      , labelSetMaxWidthChars
      , menuAttachToWidget
      , menuNewFromModel
      , menuPopupAtPointer
      , notebookAppendPage
      , notebookDetachTab
      , notebookGetNPages
      , notebookNextPage
      , notebookPageNum
      , notebookPrevPage
      , notebookSetCurrentPage
      , notebookSetShowTabs
      , notebookSetTabReorderable
      , onButtonClicked
      , onWidgetButtonPressEvent
      , onWidgetKeyPressEvent
      , scrolledWindowNew
      , scrolledWindowSetPolicy
      , setWidgetMargin
      , showUriOnWindow
      , widgetDestroy
      , widgetGrabFocus
      , widgetSetCanFocus
      , widgetSetHalign
      , widgetSetHexpand
      , widgetShow
      , windowSetFocus
      , windowSetTransientFor
      )
    import GI.Pango (EllipsizeMode(EllipsizeModeMiddle), FontDescription)
    import GI.Vte
      ( PtyFlags(PtyFlagsDefault)
      , Terminal
      , onTerminalChildExited
      , onTerminalWindowTitleChanged
      , regexNewForMatch
      , terminalGetAllowHyperlink
      , terminalGetWindowTitle
      , terminalMatchAddRegex
      , terminalMatchCheckEvent
      , terminalNew
      , terminalSetBoldIsBright
      , terminalSetCursorBlinkMode
      , terminalSetFont
      , terminalSetScrollbackLines
      , terminalSetWordCharExceptions
      , terminalSpawnSync
      , terminalSetAllowBold
      )
    import System.Directory (getSymbolicLinkTarget)
    import System.Environment (lookupEnv)

    import Termonad.Gtk (terminalSetEnableSixelIfExists)
    import Termonad.Lenses
      ( lensConfirmExit
      , lensOptions
      , lensShowScrollbar
      , lensShowTabBar
      , lensTMNotebookTabLabel
      , lensTMNotebookTabTerm
      , lensTMNotebookTabTermContainer
      , lensTMNotebookTabs
      , lensTMStateApp
      , lensTMStateConfig
      , lensTMStateNotebook
      , lensTerm
      )
    import Termonad.Types
      ( ConfigHooks(createTermHook)
      , ConfigOptions(scrollbackLen, wordCharExceptions, cursorBlinkMode, boldIsBright, enableSixel, allowBold)
      , ShowScrollbar(..)
      , ShowTabBar(..)
      , TMConfig(hooks, options)
      , TMNotebook
      , TMNotebookTab
      , TMState
      , TMState'(TMState, tmStateAppWin, tmStateConfig, tmStateFontDesc, tmStateNotebook)
      , TMTerm
      , assertInvariantTMState
      , createTMNotebookTab
      , newTMTerm
      , pid
      , tmNotebook
      , tmNotebookTabTerm
      , tmNotebookTabTermContainer
      , tmNotebookTabs
      )
    import Data.Coerce (coerce)
    import Data.GI.Base (toManagedPtr)
    import Termonad.Pcre (pcre2Multiline)

    focusTerm :: Int -> TMState -> IO ()
    focusTerm :: Int -> TMState -> IO ()
    focusTerm Int
    i TMState
    mvarTMState = do
      note <- TMNotebook -> Notebook
    tmNotebook (TMNotebook -> Notebook)
    -> (TMState' -> TMNotebook) -> TMState' -> Notebook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . TMState' -> TMNotebook
    tmStateNotebook (TMState' -> Notebook) -> IO TMState' -> IO Notebook
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      notebookSetCurrentPage note (fromIntegral i)

    altNumSwitchTerm :: Int -> TMState -> IO ()
    altNumSwitchTerm :: Int -> TMState -> IO ()
    altNumSwitchTerm = Int -> TMState -> IO ()
    focusTerm

    termNextPage :: TMState -> IO ()
    termNextPage :: TMState -> IO ()
    termNextPage TMState
    mvarTMState = do
      note <- TMNotebook -> Notebook
    tmNotebook (TMNotebook -> Notebook)
    -> (TMState' -> TMNotebook) -> TMState' -> Notebook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . TMState' -> TMNotebook
    tmStateNotebook (TMState' -> Notebook) -> IO TMState' -> IO Notebook
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      notebookNextPage note

    termPrevPage :: TMState -> IO ()
    termPrevPage :: TMState -> IO ()
    termPrevPage TMState
    mvarTMState = do
      note <- TMNotebook -> Notebook
    tmNotebook (TMNotebook -> Notebook)
    -> (TMState' -> TMNotebook) -> TMState' -> Notebook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . TMState' -> TMNotebook
    tmStateNotebook (TMState' -> Notebook) -> IO TMState' -> IO Notebook
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      notebookPrevPage note

    termExitFocused :: TMState -> IO ()
    termExitFocused :: TMState -> IO ()
    termExitFocused TMState
    mvarTMState = do
      tmState <- TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      let maybeTab =
            TMState'
    tmState TMState'
    -> Getting (Maybe TMNotebookTab) TMState' (Maybe TMNotebookTab)
    -> Maybe TMNotebookTab
    forall s a. s -> Getting a s a -> a
    ^. (TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
    -> TMState' -> Const (Maybe TMNotebookTab) TMState'
    Lens' TMState' TMNotebook
    lensTMStateNotebook ((TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
     -> TMState' -> Const (Maybe TMNotebookTab) TMState')
    -> ((Maybe TMNotebookTab
         -> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
        -> TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
    -> Getting (Maybe TMNotebookTab) TMState' (Maybe TMNotebookTab)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (FocusList TMNotebookTab
     -> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab))
    -> TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook
    Lens' TMNotebook (FocusList TMNotebookTab)
    lensTMNotebookTabs ((FocusList TMNotebookTab
      -> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab))
     -> TMNotebook -> Const (Maybe TMNotebookTab) TMNotebook)
    -> ((Maybe TMNotebookTab
         -> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
        -> FocusList TMNotebookTab
        -> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab))
    -> (Maybe TMNotebookTab
        -> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
    -> TMNotebook
    -> Const (Maybe TMNotebookTab) TMNotebook
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (FocusList TMNotebookTab -> Maybe TMNotebookTab)
    -> (Maybe TMNotebookTab
        -> Const (Maybe TMNotebookTab) (Maybe TMNotebookTab))
    -> FocusList TMNotebookTab
    -> Const (Maybe TMNotebookTab) (FocusList TMNotebookTab)
    forall (p :: * -> * -> *) (f :: * -> *) s a.
    (Profunctor p, Contravariant f) =>
    (s -> a) -> Optic' p f s a
    to FocusList TMNotebookTab -> Maybe TMNotebookTab
    forall a. FocusList a -> Maybe a
    getFocusItemFL
      case maybeTab of
        Maybe TMNotebookTab
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        Just TMNotebookTab
    tab -> TMNotebookTab -> TMState -> IO ()
    termClose TMNotebookTab
    tab TMState
    mvarTMState

    termClose :: TMNotebookTab -> TMState -> IO ()
    termClose :: TMNotebookTab -> TMState -> IO ()
    termClose TMNotebookTab
    tab TMState
    mvarTMState = do
      tmState <- TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      let confirm = TMState'
    tmState TMState' -> Getting Bool TMState' Bool -> Bool
    forall s a. s -> Getting a s a -> a
    ^. (TMConfig -> Const Bool TMConfig)
    -> TMState' -> Const Bool TMState'
    Lens' TMState' TMConfig
    lensTMStateConfig ((TMConfig -> Const Bool TMConfig)
     -> TMState' -> Const Bool TMState')
    -> ((Bool -> Const Bool Bool) -> TMConfig -> Const Bool TMConfig)
    -> Getting Bool TMState' Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (ConfigOptions -> Const Bool ConfigOptions)
    -> TMConfig -> Const Bool TMConfig
    Lens' TMConfig ConfigOptions
    lensOptions ((ConfigOptions -> Const Bool ConfigOptions)
     -> TMConfig -> Const Bool TMConfig)
    -> ((Bool -> Const Bool Bool)
        -> ConfigOptions -> Const Bool ConfigOptions)
    -> (Bool -> Const Bool Bool)
    -> TMConfig
    -> Const Bool TMConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Bool -> Const Bool Bool)
    -> ConfigOptions -> Const Bool ConfigOptions
    Lens' ConfigOptions Bool
    lensConfirmExit
          close = if Bool
    confirm then TMNotebookTab -> TMState -> IO ()
    termExitWithConfirmation else TMNotebookTab -> TMState -> IO ()
    termExit
      close tab mvarTMState

    termExitWithConfirmation :: TMNotebookTab -> TMState -> IO ()
    termExitWithConfirmation :: TMNotebookTab -> TMState -> IO ()
    termExitWithConfirmation TMNotebookTab
    tab TMState
    mvarTMState = do
      tmState <- TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      let app = TMState'
    tmState TMState' -> Getting Application TMState' Application -> Application
    forall s a. s -> Getting a s a -> a
    ^. Getting Application TMState' Application
    Lens' TMState' Application
    lensTMStateApp
      win <- applicationGetActiveWindow app
      dialog <- dialogNew
      box <- dialogGetContentArea dialog
      label <- labelNew (Just "Close tab?")
      containerAdd box label
      widgetShow label
      setWidgetMargin label 10
      void $
        dialogAddButton
          dialog
          "No, do NOT close tab"
          (fromIntegral (fromEnum ResponseTypeNo))
      void $
        dialogAddButton
          dialog
          "Yes, close tab"
          (fromIntegral (fromEnum ResponseTypeYes))
      windowSetTransientFor dialog win
      res <- dialogRun dialog
      widgetDestroy dialog
      case toEnum (fromIntegral res) of
        ResponseType
    ResponseTypeYes -> TMNotebookTab -> TMState -> IO ()
    termExit TMNotebookTab
    tab TMState
    mvarTMState
        ResponseType
    _ -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()

    termExit :: TMNotebookTab -> TMState -> IO ()
    termExit :: TMNotebookTab -> TMState -> IO ()
    termExit TMNotebookTab
    tab TMState
    mvarTMState = do
      detachTabAction <-
        TMState -> (TMState' -> IO (TMState', IO ())) -> IO (IO ())
    forall (m :: * -> *) a b.
    MonadUnliftIO m =>
    MVar a -> (a -> m (a, b)) -> m b
    modifyMVar TMState
    mvarTMState ((TMState' -> IO (TMState', IO ())) -> IO (IO ()))
    -> (TMState' -> IO (TMState', IO ())) -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ \TMState'
    tmState -> do
          let notebook :: TMNotebook
    notebook = TMState' -> TMNotebook
    tmStateNotebook TMState'
    tmState
              detachTabAction :: IO ()
    detachTabAction =
                Notebook -> ScrolledWindow -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsNotebook a, IsWidget b) =>
    a -> b -> m ()
    notebookDetachTab
                  (TMNotebook -> Notebook
    tmNotebook TMNotebook
    notebook)
                  (TMNotebookTab -> ScrolledWindow
    tmNotebookTabTermContainer TMNotebookTab
    tab)
          let newTabs :: FocusList TMNotebookTab
    newTabs = TMNotebookTab -> FocusList TMNotebookTab -> FocusList TMNotebookTab
    forall a. Eq a => a -> FocusList a -> FocusList a
    deleteFL TMNotebookTab
    tab (TMNotebook -> FocusList TMNotebookTab
    tmNotebookTabs TMNotebook
    notebook)
          let newTMState :: TMState'
    newTMState =
                ASetter
      TMState'
      TMState'
      (FocusList TMNotebookTab)
      (FocusList TMNotebookTab)
    -> FocusList TMNotebookTab -> TMState' -> TMState'
    forall s t a b. ASetter s t a b -> b -> s -> t
    set ((TMNotebook -> Identity TMNotebook)
    -> TMState' -> Identity TMState'
    Lens' TMState' TMNotebook
    lensTMStateNotebook ((TMNotebook -> Identity TMNotebook)
     -> TMState' -> Identity TMState')
    -> ((FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
        -> TMNotebook -> Identity TMNotebook)
    -> ASetter
         TMState'
         TMState'
         (FocusList TMNotebookTab)
         (FocusList TMNotebookTab)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
    -> TMNotebook -> Identity TMNotebook
    Lens' TMNotebook (FocusList TMNotebookTab)
    lensTMNotebookTabs) FocusList TMNotebookTab
    newTabs TMState'
    tmState
          (TMState', IO ()) -> IO (TMState', IO ())
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TMState'
    newTMState, IO ()
    detachTabAction)
      detachTabAction
      relabelTabs mvarTMState

    relabelTabs :: TMState -> IO ()
    relabelTabs :: TMState -> IO ()
    relabelTabs TMState
    mvarTMState = do
      TMState{tmStateNotebook} <- TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      let notebook = TMNotebook -> Notebook
    tmNotebook TMNotebook
    tmStateNotebook
          tabFocusList = TMNotebook -> FocusList TMNotebookTab
    tmNotebookTabs TMNotebook
    tmStateNotebook
      foldMap (go notebook) tabFocusList
      where
        go :: Notebook -> TMNotebookTab -> IO ()
        go :: Notebook -> TMNotebookTab -> IO ()
    go Notebook
    notebook TMNotebookTab
    tmNotebookTab = do
          let label :: Label
    label = TMNotebookTab
    tmNotebookTab TMNotebookTab -> Getting Label TMNotebookTab Label -> Label
    forall s a. s -> Getting a s a -> a
    ^. Getting Label TMNotebookTab Label
    Lens' TMNotebookTab Label
    lensTMNotebookTabLabel
              scrolledWin :: ScrolledWindow
    scrolledWin = TMNotebookTab
    tmNotebookTab TMNotebookTab
    -> Getting ScrolledWindow TMNotebookTab ScrolledWindow
    -> ScrolledWindow
    forall s a. s -> Getting a s a -> a
    ^. Getting ScrolledWindow TMNotebookTab ScrolledWindow
    Lens' TMNotebookTab ScrolledWindow
    lensTMNotebookTabTermContainer
              term' :: Terminal
    term' = TMNotebookTab
    tmNotebookTab TMNotebookTab
    -> Getting Terminal TMNotebookTab Terminal -> Terminal
    forall s a. s -> Getting a s a -> a
    ^. (TMTerm -> Const Terminal TMTerm)
    -> TMNotebookTab -> Const Terminal TMNotebookTab
    Lens' TMNotebookTab TMTerm
    lensTMNotebookTabTerm ((TMTerm -> Const Terminal TMTerm)
     -> TMNotebookTab -> Const Terminal TMNotebookTab)
    -> ((Terminal -> Const Terminal Terminal)
        -> TMTerm -> Const Terminal TMTerm)
    -> Getting Terminal TMNotebookTab Terminal
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (Terminal -> Const Terminal Terminal)
    -> TMTerm -> Const Terminal TMTerm
    Lens' TMTerm Terminal
    lensTerm
          Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
    relabelTab Notebook
    notebook Label
    label ScrolledWindow
    scrolledWin Terminal
    term'

    -- | Compute the text for a 'Label' for a GTK Notebook tab.
    --
    -- >>> computeTabLabel 0 (Just "me@machine:~")
    -- "1. me@machine:~"
    --
    -- >>> computeTabLabel 5 (Just "bash process")
    -- "6. bash process"
    --
    -- >>> computeTabLabel 2 Nothing
    -- "3. shell"
    computeTabLabel
      :: Int
      -- ^ Tab number.  0 is used for the first tab, 1 for the second, etc.
      -> Maybe Text
      -- ^ A possible title for a tab.  If this is 'Nothing', then the string
      -- @shell@ will be used.
      -> Text
    computeTabLabel :: Int -> Maybe Text -> Text
    computeTabLabel Int
    pageNum Maybe Text
    maybeTitle =
      let title :: Text
    title = Text -> Maybe Text -> Text
    forall a. a -> Maybe a -> a
    fromMaybe Text
    "shell" Maybe Text
    maybeTitle
      in Int -> Text
    forall a. Show a => a -> Text
    tshow (Int
    pageNum Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1) Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    ". " Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    title

    -- | Update the given 'Label' for a GTK Notebook tab.
    --
    -- The new text for the label is determined by the 'computeTabLabel' function.
    relabelTab :: Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
    relabelTab :: Notebook -> Label -> ScrolledWindow -> Terminal -> IO ()
    relabelTab Notebook
    notebook Label
    label ScrolledWindow
    scrolledWin Terminal
    term' = do
      tabNum <- Notebook -> ScrolledWindow -> IO Int32
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsNotebook a, IsWidget b) =>
    a -> b -> m Int32
    notebookPageNum Notebook
    notebook ScrolledWindow
    scrolledWin
      maybeTitle <- terminalGetWindowTitle term'
      let labelText = Int -> Maybe Text -> Text
    computeTabLabel (Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    tabNum) Maybe Text
    maybeTitle
      labelSetLabel label labelText

    showScrollbarToPolicy :: ShowScrollbar -> PolicyType
    showScrollbarToPolicy :: ShowScrollbar -> PolicyType
    showScrollbarToPolicy ShowScrollbar
    ShowScrollbarNever = PolicyType
    PolicyTypeNever
    showScrollbarToPolicy ShowScrollbar
    ShowScrollbarIfNeeded = PolicyType
    PolicyTypeAutomatic
    showScrollbarToPolicy ShowScrollbar
    ShowScrollbarAlways = PolicyType
    PolicyTypeAlways

    createScrolledWin :: TMState -> IO ScrolledWindow
    createScrolledWin :: TMState -> IO ScrolledWindow
    createScrolledWin TMState
    mvarTMState = do
      tmState <- TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState
      let showScrollbarVal =
            TMState'
    tmState TMState'
    -> Getting ShowScrollbar TMState' ShowScrollbar -> ShowScrollbar
    forall s a. s -> Getting a s a -> a
    ^. (TMConfig -> Const ShowScrollbar TMConfig)
    -> TMState' -> Const ShowScrollbar TMState'
    Lens' TMState' TMConfig
    lensTMStateConfig ((TMConfig -> Const ShowScrollbar TMConfig)
     -> TMState' -> Const ShowScrollbar TMState')
    -> ((ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
        -> TMConfig -> Const ShowScrollbar TMConfig)
    -> Getting ShowScrollbar TMState' ShowScrollbar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (ConfigOptions -> Const ShowScrollbar ConfigOptions)
    -> TMConfig -> Const ShowScrollbar TMConfig
    Lens' TMConfig ConfigOptions
    lensOptions ((ConfigOptions -> Const ShowScrollbar ConfigOptions)
     -> TMConfig -> Const ShowScrollbar TMConfig)
    -> ((ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
        -> ConfigOptions -> Const ShowScrollbar ConfigOptions)
    -> (ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
    -> TMConfig
    -> Const ShowScrollbar TMConfig
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (ShowScrollbar -> Const ShowScrollbar ShowScrollbar)
    -> ConfigOptions -> Const ShowScrollbar ConfigOptions
    Lens' ConfigOptions ShowScrollbar
    lensShowScrollbar
          vScrollbarPolicy = ShowScrollbar -> PolicyType
    showScrollbarToPolicy ShowScrollbar
    showScrollbarVal
      scrolledWin <-
        scrolledWindowNew
          (Nothing :: Maybe Adjustment)
          (Nothing :: Maybe Adjustment)
      widgetShow scrolledWin
      scrolledWindowSetPolicy scrolledWin PolicyTypeAutomatic vScrollbarPolicy
      pure scrolledWin

    createNotebookTabLabel :: IO (Box, Label, Button)
    createNotebookTabLabel :: IO (Box, Label, Button)
    createNotebookTabLabel = do
      box <- Orientation -> Int32 -> IO Box
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Orientation -> Int32 -> m Box
    boxNew Orientation
    OrientationHorizontal Int32
    5
      label <- labelNew (Just "")
      labelSetEllipsize label EllipsizeModeMiddle
      labelSetMaxWidthChars label 10
      widgetSetHexpand label True
      widgetSetHalign label AlignFill
      button <-
        buttonNewFromIconName
          (Just "window-close")
          (fromIntegral (fromEnum IconSizeMenu))
      buttonSetRelief button ReliefStyleNone
      containerAdd box label
      containerAdd box button
      widgetSetCanFocus button False
      widgetSetCanFocus label False
      widgetSetCanFocus box False
      widgetShow box
      widgetShow label
      widgetShow button
      pure (box, label, button)

    setShowTabs :: TMConfig -> Notebook -> IO ()
    setShowTabs :: TMConfig -> Notebook -> IO ()
    setShowTabs TMConfig
    tmConfig Notebook
    note = do
      npages <- Notebook -> IO Int32
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsNotebook a) =>
    a -> m Int32
    notebookGetNPages Notebook
    note
      let shouldShowTabs =
            case TMConfig
    tmConfig TMConfig -> Getting ShowTabBar TMConfig ShowTabBar -> ShowTabBar
    forall s a. s -> Getting a s a -> a
    ^. (ConfigOptions -> Const ShowTabBar ConfigOptions)
    -> TMConfig -> Const ShowTabBar TMConfig
    Lens' TMConfig ConfigOptions
    lensOptions ((ConfigOptions -> Const ShowTabBar ConfigOptions)
     -> TMConfig -> Const ShowTabBar TMConfig)
    -> ((ShowTabBar -> Const ShowTabBar ShowTabBar)
        -> ConfigOptions -> Const ShowTabBar ConfigOptions)
    -> Getting ShowTabBar TMConfig ShowTabBar
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (ShowTabBar -> Const ShowTabBar ShowTabBar)
    -> ConfigOptions -> Const ShowTabBar ConfigOptions
    Lens' ConfigOptions ShowTabBar
    lensShowTabBar of
              ShowTabBar
    ShowTabBarIfNeeded -> Int32
    npages Int32 -> Int32 -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int32
    1
              ShowTabBar
    ShowTabBarAlways   -> Bool
    True
              ShowTabBar
    ShowTabBarNever    -> Bool
    False
      notebookSetShowTabs note shouldShowTabs

    toRGBA :: Colour Double -> IO RGBA
    toRGBA :: Colour Double -> IO RGBA
    toRGBA Colour Double
    colour = do
      let RGB Double
    red Double
    green Double
    blue = Colour Double -> RGB Double
    forall b. (Ord b, Floating b) => Colour b -> RGB b
    toSRGB Colour Double
    colour
      rgba <- IO RGBA
    forall (m :: * -> *). MonadIO m => m RGBA
    newZeroRGBA
      setRGBARed rgba red
      setRGBAGreen rgba green
      setRGBABlue rgba blue
      pure rgba

    -- | TODO: This should probably be implemented in an external package,
    -- since it is a generally useful utility.
    --
    -- It should also be implemented for windows and osx.
    cwdOfPid :: Int -> IO (Maybe Text)
    cwdOfPid :: Int -> IO (Maybe Text)
    cwdOfPid Int
    pd = do
    #ifdef mingw32_HOST_OS
      pure Nothing
    #else
    #ifdef darwin_HOST_OS
      pure Nothing
    #else
      let pidPath :: String
    pidPath = String
    "/proc" String -> String -> String
    </> Int -> String
    forall a. Show a => a -> String
    show Int
    pd String -> String -> String
    </> String
    "cwd"
      eitherLinkTarget <- IO String -> IO (Either IOException String)
    forall (m :: * -> *) e a.
    (MonadUnliftIO m, Exception e) =>
    m a -> m (Either e a)
    try (IO String -> IO (Either IOException String))
    -> IO String -> IO (Either IOException String)
    forall a b. (a -> b) -> a -> b
    $ String -> IO String
    getSymbolicLinkTarget String
    pidPath
      case eitherLinkTarget of
        Left (IOException
    _ :: IOException) -> Maybe Text -> IO (Maybe Text)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Text
    forall a. Maybe a
    Nothing
        Right String
    linkTarget -> Maybe Text -> IO (Maybe Text)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
    forall a b. (a -> b) -> a -> b
    $ Text -> Maybe Text
    forall a. a -> Maybe a
    Just (Text -> Maybe Text) -> Text -> Maybe Text
    forall a b. (a -> b) -> a -> b
    $ [Element Text] -> Text
    forall seq. IsSequence seq => [Element seq] -> seq
    pack String
    [Element Text]
    linkTarget
    #endif
    #endif

    -- | Get the current working directory from the shell in the focused tab of a
    -- notebook.
    --
    -- Returns 'Nothing' if there is no focused tab of the notebook, or the
    -- current working directory could not be detected for the shell.
    getCWDFromFocusedTab :: TMNotebook -> IO (Maybe Text)
    getCWDFromFocusedTab :: TMNotebook -> IO (Maybe Text)
    getCWDFromFocusedTab TMNotebook
    currNote = do
      let maybeFocusedTab :: Maybe TMNotebookTab
    maybeFocusedTab = FocusList TMNotebookTab -> Maybe TMNotebookTab
    forall a. FocusList a -> Maybe a
    getFocusItemFL (TMNotebook -> FocusList TMNotebookTab
    tmNotebookTabs TMNotebook
    currNote)
      case Maybe TMNotebookTab
    maybeFocusedTab of
        Maybe TMNotebookTab
    Nothing -> Maybe Text -> IO (Maybe Text)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Text
    forall a. Maybe a
    Nothing
        Just TMNotebookTab
    focusedNotebookTab -> do
          let shellPid :: Int
    shellPid = TMTerm -> Int
    pid (TMNotebookTab -> TMTerm
    tmNotebookTabTerm TMNotebookTab
    focusedNotebookTab)
          Int -> IO (Maybe Text)
    cwdOfPid Int
    shellPid

    -- | Create the VTE 'Terminal', set the fonts and options
    createAndInitVteTerm :: FontDescription -> ConfigOptions -> IO Terminal
    createAndInitVteTerm :: FontDescription -> ConfigOptions -> IO Terminal
    createAndInitVteTerm FontDescription
    tmStateFontDesc ConfigOptions
    curOpts = do
      vteTerm <- IO Terminal
    forall (m :: * -> *). (HasCallStack, MonadIO m) => m Terminal
    terminalNew
      terminalSetFont vteTerm (Just tmStateFontDesc)
      terminalSetWordCharExceptions vteTerm $ wordCharExceptions curOpts
      terminalSetScrollbackLines vteTerm (fromIntegral (scrollbackLen curOpts))
      terminalSetCursorBlinkMode vteTerm (cursorBlinkMode curOpts)
      terminalSetBoldIsBright vteTerm (boldIsBright curOpts)
      terminalSetEnableSixelIfExists vteTerm (enableSixel curOpts)
      terminalSetAllowBold vteTerm (allowBold curOpts)
      widgetShow vteTerm
      pure vteTerm

    -- | Starts a shell in a terminal and return a new TMTerm
    launchShell
      :: Terminal
      -- ^ GTK 'Terminal' to spawn the shell in.
      -> Maybe Text
      -- ^ An optional path to the current working directory to start the
      -- shell in.  If 'Nothing', use the current working directory of the
      -- termonad process.
      -> IO Int
    launchShell :: Terminal -> Maybe Text -> IO Int
    launchShell Terminal
    vteTerm Maybe Text
    maybeCurrDir = do
      -- Should probably use GI.Vte.Functions.getUserShell, but contrary to its
      -- documentation it raises an exception rather wrap in Maybe.
      mShell <- String -> IO (Maybe String)
    lookupEnv String
    "SHELL"
      let argv = [String] -> (String -> [String]) -> Maybe String -> [String]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [String
    Item [String]
    "/usr/bin/env", String
    Item [String]
    "bash"] String -> [String]
    forall a. a -> [a]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe String
    mShell
      -- Launch the shell
      shellPid <-
        terminalSpawnSync
          vteTerm
          [PtyFlagsDefault]
          maybeCurrDir
          argv
          Nothing
          ([SpawnFlagsDefault] :: [SpawnFlags])
          Nothing
          (Nothing :: Maybe Cancellable)
      pure (fromIntegral shellPid)

    -- | Add a page to the notebook and switch to it.
    addPage
      :: TMState
      -> TMNotebookTab
      -> Box
      -- ^ The GTK Object holding the label we want to show for the tab of the
      -- newly created page of the notebook.
      -> IO ()
    addPage :: TMState -> TMNotebookTab -> Box -> IO ()
    addPage TMState
    mvarTMState TMNotebookTab
    notebookTab Box
    tabLabelBox = do
      -- Append a new notebook page and update the TMState to reflect this.
      (note, pageIndex) <- TMState
    -> (TMState' -> IO (TMState', (Notebook, Int32)))
    -> IO (Notebook, Int32)
    forall (m :: * -> *) a b.
    MonadUnliftIO m =>
    MVar a -> (a -> m (a, b)) -> m b
    modifyMVar TMState
    mvarTMState TMState' -> IO (TMState', (Notebook, Int32))
    appendNotebookPage

      -- Switch the current Notebook page to the the newly added page.
      notebookSetCurrentPage note pageIndex
      where
        appendNotebookPage :: TMState' -> IO (TMState', (Notebook, Int32))
        appendNotebookPage :: TMState' -> IO (TMState', (Notebook, Int32))
    appendNotebookPage TMState'
    tmState = do
          let notebook :: TMNotebook
    notebook = TMState' -> TMNotebook
    tmStateNotebook TMState'
    tmState
              note :: Notebook
    note = TMNotebook -> Notebook
    tmNotebook TMNotebook
    notebook
              tabs :: FocusList TMNotebookTab
    tabs = TMNotebook -> FocusList TMNotebookTab
    tmNotebookTabs TMNotebook
    notebook
              scrolledWin :: ScrolledWindow
    scrolledWin = TMNotebookTab -> ScrolledWindow
    tmNotebookTabTermContainer TMNotebookTab
    notebookTab
          pageIndex <- Notebook -> ScrolledWindow -> Maybe Box -> IO Int32
    forall (m :: * -> *) a b c.
    (HasCallStack, MonadIO m, IsNotebook a, IsWidget b, IsWidget c) =>
    a -> b -> Maybe c -> m Int32
    notebookAppendPage Notebook
    note ScrolledWindow
    scrolledWin (Box -> Maybe Box
    forall a. a -> Maybe a
    Just Box
    tabLabelBox)
          notebookSetTabReorderable note scrolledWin True
          setShowTabs (tmState ^. lensTMStateConfig) note
          let newTabs = FocusList TMNotebookTab -> TMNotebookTab -> FocusList TMNotebookTab
    forall a. FocusList a -> a -> FocusList a
    appendFL FocusList TMNotebookTab
    tabs TMNotebookTab
    notebookTab
              newTMState =
                TMState'
    tmState TMState' -> (TMState' -> TMState') -> TMState'
    forall a b. a -> (a -> b) -> b
    & (TMNotebook -> Identity TMNotebook)
    -> TMState' -> Identity TMState'
    Lens' TMState' TMNotebook
    lensTMStateNotebook ((TMNotebook -> Identity TMNotebook)
     -> TMState' -> Identity TMState')
    -> ((FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
        -> TMNotebook -> Identity TMNotebook)
    -> ASetter
         TMState'
         TMState'
         (FocusList TMNotebookTab)
         (FocusList TMNotebookTab)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . (FocusList TMNotebookTab -> Identity (FocusList TMNotebookTab))
    -> TMNotebook -> Identity TMNotebook
    Lens' TMNotebook (FocusList TMNotebookTab)
    lensTMNotebookTabs ASetter
      TMState'
      TMState'
      (FocusList TMNotebookTab)
      (FocusList TMNotebookTab)
    -> FocusList TMNotebookTab -> TMState' -> TMState'
    forall s t a b. ASetter s t a b -> b -> s -> t
    .~ FocusList TMNotebookTab
    newTabs
          pure (newTMState, (note, pageIndex))

    -- | Set the keyboard focus on a vte terminal
    setFocusOn :: ApplicationWindow -> Terminal -> IO()
    setFocusOn :: ApplicationWindow -> Terminal -> IO ()
    setFocusOn ApplicationWindow
    tmStateAppWin Terminal
    vteTerm = do
      Terminal -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWidget a) =>
    a -> m ()
    widgetGrabFocus Terminal
    vteTerm
      ApplicationWindow -> Maybe Terminal -> IO ()
    forall (m :: * -> *) a b.
    (HasCallStack, MonadIO m, IsWindow a, IsWidget b) =>
    a -> Maybe b -> m ()
    windowSetFocus ApplicationWindow
    tmStateAppWin (Terminal -> Maybe Terminal
    forall a. a -> Maybe a
    Just Terminal
    vteTerm)

    -- | Create a new 'TMTerm', setting it up and adding it to the GTKNotebook.
    createTerm
      :: (TMState -> EventKey -> IO Bool)
      -- ^ Funtion for handling key presses on the terminal.
      -> TMState
      -> IO TMTerm
    createTerm :: (TMState -> EventKey -> IO Bool) -> TMState -> IO TMTerm
    createTerm TMState -> EventKey -> IO Bool
    handleKeyPress TMState
    mvarTMState = do
      -- Check preconditions
      TMState -> IO ()
    assertInvariantTMState TMState
    mvarTMState

      -- Read needed data in TMVar
      TMState{tmStateAppWin, tmStateFontDesc, tmStateConfig, tmStateNotebook=currNote} <-
        TMState -> IO TMState'
    forall (m :: * -> *) a. MonadIO m => MVar a -> m a
    readMVar TMState
    mvarTMState

      -- Create a new terminal and launch a shell in it
      vteTerm <- createAndInitVteTerm tmStateFontDesc (options tmStateConfig)
      maybeCurrDir <- getCWDFromFocusedTab currNote
      termShellPid <- launchShell vteTerm maybeCurrDir
      tmTerm <- newTMTerm vteTerm termShellPid

      -- Create the container add the VTE term in it
      scrolledWin <- createScrolledWin mvarTMState
      containerAdd scrolledWin vteTerm

      -- Create the GTK widget for the Notebook tab
      (tabLabelBox, tabLabel, tabCloseButton) <- createNotebookTabLabel

      -- Create notebook state
      let notebookTab = Label -> ScrolledWindow -> TMTerm -> TMNotebookTab
    createTMNotebookTab Label
    tabLabel ScrolledWindow
    scrolledWin TMTerm
    tmTerm

      -- Add the new notebooktab to the notebook.
      addPage mvarTMState notebookTab tabLabelBox

      -- Setup the initial label for the notebook tab.  This needs to happen
      -- after we add the new page to the notebook, so that the page can get labelled
      -- appropriately.
      relabelTab (tmNotebook currNote) tabLabel scrolledWin vteTerm

      -- Connect callbacks
      void $ onButtonClicked tabCloseButton $ termClose notebookTab mvarTMState
      void $ onTerminalWindowTitleChanged vteTerm $ do
        TMState{tmStateNotebook} <- readMVar mvarTMState
        let notebook = TMNotebook -> Notebook
    tmNotebook TMNotebook
    tmStateNotebook
        relabelTab notebook tabLabel scrolledWin vteTerm
      void $ onWidgetKeyPressEvent vteTerm $ handleKeyPress mvarTMState
      void $ onWidgetKeyPressEvent scrolledWin $ handleKeyPress mvarTMState
      void $ onWidgetButtonPressEvent vteTerm $ handleMousePress tmStateAppWin vteTerm
      void $ onTerminalChildExited vteTerm $ \Int32
    _ -> TMNotebookTab -> TMState -> IO ()
    termExit TMNotebookTab
    notebookTab TMState
    mvarTMState

      -- Underline URLs so that the user can see they are right-clickable.
      --
      -- This regex is from https://www.regextester.com/94502
      --
      -- TODO: Roxterm and gnome-terminal have a much more in-depth set of regexes
      -- for URLs and things similar to URLs.  At some point it might make sense to
      -- switch to something like this:
      -- https://github.com/realh/roxterm/blob/30f1faf8be4ccac8ba12b59feb5b8f758bc65a7b/src/roxterm-regex.c
      -- and
      -- https://github.com/realh/roxterm/blob/30f1faf8be4ccac8ba12b59feb5b8f758bc65a7b/src/terminal-regex.h
      let regexPat =
            Text
    "(?:http(s)?:\\/\\/)[\\w.-]+(?:\\.[\\w\\.-]+)+[\\w\\-\\._~:/?#[\\]@!\\$&'\\(\\)\\*\\+,;=.]+"
      -- We must set the pcre2Multiline option, otherwise VTE prints a warning.
      let pcreFlags = CUInt -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral CUInt
    pcre2Multiline
      regex <- regexNewForMatch regexPat (fromIntegral $ length regexPat) pcreFlags
      void $ terminalMatchAddRegex vteTerm regex 0

      -- Put the keyboard focus on the term
      setFocusOn tmStateAppWin vteTerm

      -- Make sure the state is still right
      assertInvariantTMState mvarTMState

      -- Run user-defined hooks for modifying the newly-created VTE Terminal.
      createTermHook (hooks tmStateConfig) mvarTMState vteTerm
      pure tmTerm

    -- | Popup the context menu on right click
    handleMousePress :: ApplicationWindow -> Terminal -> EventButton -> IO Bool
    handleMousePress :: ApplicationWindow -> Terminal -> WidgetButtonPressEventCallback
    handleMousePress ApplicationWindow
    win Terminal
    vteTerm EventButton
    eventButton = do
      x <- Terminal -> IO Bool
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsTerminal a) =>
    a -> m Bool
    terminalGetAllowHyperlink Terminal
    vteTerm
      print x
      button <- getEventButtonButton eventButton
      let rightClick = Word32
    button Word32 -> Word32 -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    BUTTON_SECONDARY
      when rightClick $ do
        menuModel <- menuNew

        -- if the user right-clicked on a URL, add an option to open the URL
        -- in a browser
        (maybeUrl, _regexId) <- terminalMatchCheckEvent vteTerm (eventButtonToEvent eventButton)
        case maybeUrl of
          Maybe Text
    Nothing -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
          Just Text
    url -> do
            openUrlAction <- Text -> Maybe VariantType -> IO SimpleAction
    forall (m :: * -> *).
    (HasCallStack, MonadIO m) =>
    Text -> Maybe VariantType -> m SimpleAction
    simpleActionNew Text
    "openurl" Maybe VariantType
    forall a. Maybe a
    Nothing
            void $ onSimpleActionActivate openUrlAction $ \Maybe GVariant
    _ ->
              Maybe Window -> Text -> Word32 -> IO ()
    forall (m :: * -> *) a.
    (HasCallStack, MonadIO m, IsWindow a) =>
    Maybe a -> Text -> Word32 -> m ()
    showUriOnWindow (Maybe Window
    forall a. Maybe a
    Nothing :: Maybe Window) Text
    url (Int32 -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int32
    CURRENT_TIME)
            -- This will add the openurl action to the Application Window's action
            -- map everytime the user right-clicks on a URL.  It is okay to add
            -- actions multiple times.
            actionMapAddAction win openUrlAction
            menuAppend menuModel (Just "Open URL in browser") (Just "win.openurl")

        menuAppend menuModel (Just "Copy") (Just "app.copy")
        menuAppend menuModel (Just "Paste") (Just "app.paste")
        menuAppend menuModel (Just "Preferences") (Just "app.preferences")
        menu <- menuNewFromModel menuModel
        menuAttachToWidget menu vteTerm Nothing
        menuPopupAtPointer menu Nothing
      pure rightClick

    -- The terminalMatchCheckEvent function takes an Event, while we only
    -- have an EventButton.  It is apparently okay to just cast an EventButton
    -- to an Event, since they are just pointers under the hood, and they
    -- are laid out the same in memory.  See
    -- https://github.com/haskell-gi/haskell-gi/issues/109
    eventButtonToEvent :: EventButton -> Event
    eventButtonToEvent :: EventButton -> Event
    eventButtonToEvent = ManagedPtr Event -> Event
    Event (ManagedPtr Event -> Event)
    -> (EventButton -> ManagedPtr Event) -> EventButton -> Event
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . ManagedPtr EventButton -> ManagedPtr Event
    forall a b. Coercible a b => a -> b
    coerce (ManagedPtr EventButton -> ManagedPtr Event)
    -> (EventButton -> ManagedPtr EventButton)
    -> EventButton
    -> ManagedPtr Event
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
    Category cat =>
    cat b c -> cat a b -> cat a c
    . EventButton -> ManagedPtr EventButton
    forall a. ManagedPtrNewtype a => a -> ManagedPtr a
    toManagedPtr