content: {-# OPTIONS_GHC -fno-warn-orphans #-}
  
  module Termonad.Types where
  
  import Termonad.Prelude
  
  import Control.Lens (ifoldMap)
  import Data.FocusList (FocusList, emptyFL, getFocusItemFL, lengthFL)
  import Data.Foldable (toList)
  import Data.Unique (Unique, hashUnique, newUnique)
  import Data.Yaml
    ( FromJSON(parseJSON)
    , ToJSON(toJSON)
    , Value(String)
    , withText
    )
  import GI.Gtk
    ( Application
    , ApplicationWindow
    , IsWidget
    , Label
    , Notebook
    , ScrolledWindow
    , Widget
    , notebookGetCurrentPage
    , notebookGetNthPage
    , notebookGetNPages
    )
  import GI.Pango (FontDescription, fontDescriptionGetSize, fontDescriptionGetSizeIsAbsolute, pattern SCALE, fontDescriptionGetFamily, fontDescriptionNew, fontDescriptionSetFamily, fontDescriptionSetSize, fontDescriptionSetAbsoluteSize)
  import GI.Vte (Terminal, CursorBlinkMode(..))
  import Termonad.Gtk (widgetEq)
  import Termonad.IdMap (IdMap, IdMapKey, singletonIdMap, lookupIdMap)
  import Text.Pretty.Simple (pPrint)
  
  -- | A wrapper around a VTE 'Terminal'.  This also stores the process ID of the
  -- process running on this terminal, as well as a 'Unique' that can be used for
  -- comparing terminals.
  data TMTerm = TMTerm
    { term :: !Terminal
      -- ^ The actual 'Terminal'.
    , pid :: !Int
      -- ^ The process ID of the process running in 'term'.
    , unique :: !Unique
      -- ^ A 'Unique' for comparing different 'TMTerm' for uniqueness.
    }
  
  instance Show TMTerm where
    showsPrec :: Int -> TMTerm -> ShowS
    showsPrec d TMTerm{..} =
      showParen (d > 10) $
        showString "TMTerm {" .
        showString "term = " .
        showString "(GI.GTK.Terminal)" .
        showString ", " .
        showString "pid = " .
        showsPrec (d + 1) pid .
        showString ", " .
        showString "unique = " .
        showsPrec (d + 1) (hashUnique unique) .
        showString "}"
  
  -- | A container that holds everything in a given terminal window.  The 'term'
  -- in the 'TMTerm' is inside the 'tmNotebookTabTermContainer' 'ScrolledWindow'.
  -- The notebook tab 'Label' is also available.
  data TMNotebookTab = TMNotebookTab
    { tmNotebookTabTermContainer :: !ScrolledWindow
      -- ^ The 'ScrolledWindow' holding the VTE 'Terminal'.
    , tmNotebookTabTerm :: !TMTerm
      -- ^ The 'Terminal' insidie the 'ScrolledWindow'.
    , tmNotebookTabLabel :: !Label
      -- ^ The 'Label' holding the title of the 'Terminal' in the 'Notebook' tab.
    }
  
  instance Show TMNotebookTab where
    showsPrec :: Int -> TMNotebookTab -> ShowS
    showsPrec d TMNotebookTab{..} =
      showParen (d > 10) $
        showString "TMNotebookTab {" .
        showString "tmNotebookTabTermContainer = " .
        showString "(GI.GTK.ScrolledWindow)" .
        showString ", " .
        showString "tmNotebookTabTerm = " .
        showsPrec (d + 1) tmNotebookTabTerm .
        showString ", " .
        showString "tmNotebookTabLabel = " .
        showString "(GI.GTK.Label)" .
        showString "}"
  
  -- | This holds the GTK 'Notebook' containing multiple tabs of 'Terminal's.  We
  -- keep a separate list of terminals in 'tmNotebookTabs'.
  data TMNotebook = TMNotebook
    { tmNotebook :: !Notebook
      -- ^ This is the GTK 'Notebook' that holds multiple tabs of 'Terminal's.
    , tmNotebookTabs :: !(FocusList TMNotebookTab)
      -- ^ A 'FocusList' containing references to each individual 'TMNotebookTab'.
    }
  
  instance Show TMNotebook where
    showsPrec :: Int -> TMNotebook -> ShowS
    showsPrec d TMNotebook{..} =
      showParen (d > 10) $
        showString "TMNotebook {" .
        showString "tmNotebook = " .
        showString "(GI.GTK.Notebook)" .
        showString ", " .
        showString "tmNotebookTabs = " .
        showsPrec (d + 1) tmNotebookTabs .
        showString "}"
  
  getNotebookFromTMState :: TMState -> TMWindowId -> IO Notebook
  getNotebookFromTMState mvarTMState tmWinId = do
    tmNote <- getTMNotebookFromTMState mvarTMState tmWinId
    pure $ tmNotebook tmNote
  
  getNotebookFromTMState' :: TMState' -> TMWindowId -> IO Notebook
  getNotebookFromTMState' tmState tmWinId = do
    tmNote <- getTMNotebookFromTMState' tmState tmWinId
    pure $ tmNotebook tmNote
  
  getTMNotebookFromTMState :: TMState -> TMWindowId -> IO TMNotebook
  getTMNotebookFromTMState mvarTMState tmWinId = do
    tmWin <- getTMWindowFromTMState mvarTMState tmWinId
    pure $ tmWindowNotebook tmWin
  
  getTMNotebookFromTMState' :: TMState' -> TMWindowId -> IO TMNotebook
  getTMNotebookFromTMState' tmState tmWinId = do
    tmWin <- getTMWindowFromTMState' tmState tmWinId
    pure $ tmWindowNotebook tmWin
  
  data TMWindow = TMWindow
    { tmWindowAppWin :: !ApplicationWindow
    , tmWindowNotebook :: !TMNotebook
    }
  
  instance Show TMWindow where
    showsPrec :: Int -> TMWindow -> ShowS
    showsPrec d TMWindow{..} =
      showParen (d > 10) $
        showString "TMWindow {" .
        showString "tmWindowAppWin = " .
        showString "(GI.GTK.ApplicationWindow)" .
        showString ", " .
        showString "tmWindowNotebook = " .
        showsPrec (d + 1) tmWindowNotebook .
        showString "}"
  
  type TMWindowId = IdMapKey
  
  -- | Get a given 'TMWindow' from a set of 'TMWindow's given a 'TMWindowId'.
  --
  -- This throws an error if the 'TMWindowId' can't be found within the 'IdMap'.
  getTMWindowFromWins :: IdMap TMWindow -> TMWindowId -> IO TMWindow
  getTMWindowFromWins tmWins tmWinId =
    case lookupIdMap tmWinId tmWins of
      Nothing -> error $ "getTMWindowFromWins: trying to get id " <> show tmWinId <> " from wins, but doesn't exist: " <> show tmWins
      Just tmWin -> pure tmWin
  
  -- | Get a given 'TMWindow' froma a 'TMState' given a 'TMWindowId'.
  --
  -- This throws an error if the 'TMWindowId' can't be found within the 'TMState'.
  getTMWindowFromTMState :: TMState -> TMWindowId -> IO TMWindow
  getTMWindowFromTMState mvarTMState tmWinId = do
    TMState{tmStateWindows} <- readMVar mvarTMState
    getTMWindowFromWins tmStateWindows tmWinId
  
  getTMWindowFromTMState' :: TMState' -> TMWindowId -> IO TMWindow
  getTMWindowFromTMState' tmState tmWinId =
    getTMWindowFromWins (tmStateWindows tmState) tmWinId
  
  data TMState' = TMState
    { tmStateApp :: !Application
    , tmStateConfig :: !TMConfig
    , tmStateFontDesc :: !FontDescription
    , tmStateWindows :: !(IdMap TMWindow)
    }
  
  instance Show TMState' where
    showsPrec :: Int -> TMState' -> ShowS
    showsPrec d TMState{..} =
      showParen (d > 10) $
        showString "TMState {" .
        showString "tmStateApp = " .
        showString "(GI.GTK.Application)" .
        showString ", " .
        showString "tmStateConfig = " .
        showsPrec (d + 1) tmStateConfig .
        showString ", " .
        showString "tmStateFontDesc = " .
        showString "(GI.Pango.FontDescription)" .
        showString ", " .
        showString "tmStateWindows = " .
        showsPrec (d + 1) tmStateWindows .
        showString "}"
  
  type TMState = MVar TMState'
  
  instance Eq TMTerm where
    (==) :: TMTerm -> TMTerm -> Bool
    (==) = (==) `on` (unique :: TMTerm -> Unique)
  
  instance Eq TMNotebookTab where
    (==) :: TMNotebookTab -> TMNotebookTab -> Bool
    (==) = (==) `on` tmNotebookTabTerm
  
  createTMTerm :: Terminal -> Int -> Unique -> TMTerm
  createTMTerm trm pd unq =
    TMTerm
      { term = trm
      , pid = pd
      , unique = unq
      }
  
  newTMTerm :: Terminal -> Int -> IO TMTerm
  newTMTerm trm pd = createTMTerm trm pd <$> newUnique
  
  getFocusedTermFromState :: TMState -> TMWindowId -> IO (Maybe Terminal)
  getFocusedTermFromState mvarTMState tmWinId =
    withMVar mvarTMState go
    where
      go :: TMState' -> IO (Maybe Terminal)
      go tmState = do
        tmNote <- getTMNotebookFromTMState' tmState tmWinId
        let maybeNotebookTab = getFocusItemFL $ tmNotebookTabs tmNote
        pure $ fmap (term . tmNotebookTabTerm) maybeNotebookTab
  
  createTMNotebookTab :: Label -> ScrolledWindow -> TMTerm -> TMNotebookTab
  createTMNotebookTab tabLabel scrollWin trm =
    TMNotebookTab
      { tmNotebookTabTermContainer = scrollWin
      , tmNotebookTabTerm = trm
      , tmNotebookTabLabel = tabLabel
      }
  
  createTMNotebook :: Notebook -> FocusList TMNotebookTab -> TMNotebook
  createTMNotebook note tabs =
    TMNotebook
      { tmNotebook = note
      , tmNotebookTabs = tabs
      }
  
  createEmptyTMNotebook :: Notebook -> TMNotebook
  createEmptyTMNotebook notebook = createTMNotebook notebook emptyFL
  
  notebookToList :: Notebook -> IO [Widget]
  notebookToList notebook =
    unfoldHelper 0 []
    where unfoldHelper :: Int32 -> [Widget] -> IO [Widget]
          unfoldHelper index32 acc = do
            notePage <- notebookGetNthPage notebook index32
            case notePage of
              Nothing -> pure acc
              Just notePage' -> unfoldHelper (index32 + 1) (acc ++ [notePage'])
  
  createTMWindow :: ApplicationWindow -> TMNotebook -> TMWindow
  createTMWindow appwin notebook =
    TMWindow
      { tmWindowAppWin = appwin
      , tmWindowNotebook = notebook
      }
  
  newEmptyTMState :: TMConfig -> Application -> ApplicationWindow -> Notebook -> FontDescription -> IO (TMState, TMWindowId)
  newEmptyTMState tmConfig app appWin note fontDesc = do
    let tmnote = createEmptyTMNotebook note
        tmwin = createTMWindow appWin tmnote
        (tmwinId, tmwins) = singletonIdMap tmwin
    tmState <-
      newMVar $
        TMState
          { tmStateApp = app
          , tmStateConfig = tmConfig
          , tmStateFontDesc = fontDesc
          , tmStateWindows = tmwins
          }
    pure (tmState, tmwinId)
  
  ------------
  -- Config --
  ------------
  
  -- | The font size for the Termonad terminal.  There are two ways to set the
  -- fontsize, corresponding to the two different ways to set the font size in
  -- the Pango font rendering library.
  --
  -- If you're not sure which to use, try 'FontSizePoints' first and see how it
  -- looks.  It should generally correspond to font sizes you are used to from
  -- other applications.
  data FontSize
    = FontSizePoints Int
      -- ^ This sets the font size based on \"points\".  The conversion between a
      -- point and an actual size depends on the system configuration and the
      -- output device.  The function 'GI.Pango.fontDescriptionSetSize' is used
      -- to set the font size.  See the documentation for that function for more
      -- info.
    | FontSizeUnits Double
      -- ^ This sets the font size based on \"device units\".  In general, this
      -- can be thought of as one pixel.  The function
      -- 'GI.Pango.fontDescriptionSetAbsoluteSize' is used to set the font size.
      -- See the documentation for that function for more info.
    deriving (Eq, FromJSON, Generic, Show, ToJSON)
  
  -- | The default 'FontSize' used if not specified.
  --
  -- >>> defaultFontSize
  -- FontSizePoints 12
  defaultFontSize :: FontSize
  defaultFontSize = FontSizePoints 12
  
  -- | Modify a 'FontSize' by adding some value.
  --
  -- >>> modFontSize 1 (FontSizePoints 13)
  -- FontSizePoints 14
  -- >>> modFontSize 1 (FontSizeUnits 9.0)
  -- FontSizeUnits 10.0
  --
  -- You can reduce the font size by passing a negative value.
  --
  -- >>> modFontSize (-2) (FontSizePoints 13)
  -- FontSizePoints 11
  --
  -- If you try to create a font size less than 1, then the old font size will be
  -- used.
  --
  -- >>> modFontSize (-10) (FontSizePoints 5)
  -- FontSizePoints 5
  -- >>> modFontSize (-1) (FontSizeUnits 1.0)
  -- FontSizeUnits 1.0
  modFontSize :: Int -> FontSize -> FontSize
  modFontSize i (FontSizePoints oldPoints) =
    let newPoints = oldPoints + i
    in FontSizePoints $ if newPoints < 1 then oldPoints else newPoints
  modFontSize i (FontSizeUnits oldUnits) =
    let newUnits = oldUnits + fromIntegral i
    in FontSizeUnits $ if newUnits < 1 then oldUnits else newUnits
  
  fontSizeFromFontDescription :: FontDescription -> IO FontSize
  fontSizeFromFontDescription fontDesc = do
    currSize <- fontDescriptionGetSize fontDesc
    currAbsolute <- fontDescriptionGetSizeIsAbsolute fontDesc
    pure $
      if currAbsolute
      then FontSizeUnits $ fromIntegral currSize / fromIntegral SCALE
      else
        let fontRatio :: Double = fromIntegral currSize / fromIntegral SCALE
        in FontSizePoints $ round fontRatio
  
  -- | Create a 'FontDescription' from a 'FontSize' and font family.
  createFontDesc
    :: FontSize
    -> Text
    -- ^ font family
    -> IO FontDescription
  createFontDesc fontSz fontFam = do
    fontDesc <- fontDescriptionNew
    fontDescriptionSetFamily fontDesc fontFam
    setFontDescSize fontDesc fontSz
    pure fontDesc
  
  -- | Set the size of a 'FontDescription' from a 'FontSize'.
  setFontDescSize :: FontDescription -> FontSize -> IO ()
  setFontDescSize fontDesc (FontSizePoints points) =
    fontDescriptionSetSize fontDesc $ fromIntegral (points * fromIntegral SCALE)
  setFontDescSize fontDesc (FontSizeUnits units) =
    fontDescriptionSetAbsoluteSize fontDesc $ units * fromIntegral SCALE
  
  -- | Create a 'FontDescription' from the 'fontSize' and 'fontFamily' inside a 'TMConfig'.
  createFontDescFromConfig :: TMConfig -> IO FontDescription
  createFontDescFromConfig tmConfig = do
    let fontConf = fontConfig (options tmConfig)
    createFontDesc (fontSize fontConf) (fontFamily fontConf)
  
  -- | Settings for the font to be used in Termonad.
  data FontConfig = FontConfig
    { fontFamily :: !Text
      -- ^ The font family to use.  Example: @"DejaVu Sans Mono"@ or @"Source Code Pro"@
    , fontSize :: !FontSize
      -- ^ The font size.
    } deriving (Eq, FromJSON, Generic, Show, ToJSON)
  
  -- | The default 'FontConfig' to use if not specified.
  --
  -- >>> defaultFontConfig == FontConfig {fontFamily = "Monospace", fontSize = defaultFontSize}
  -- True
  defaultFontConfig :: FontConfig
  defaultFontConfig =
    FontConfig
      { fontFamily = "Monospace"
      , fontSize = defaultFontSize
      }
  
  fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig)
  fontConfigFromFontDescription fontDescription = do
    fontSize <- fontSizeFromFontDescription fontDescription
    maybeFontFamily <- fontDescriptionGetFamily fontDescription
    return $ (`FontConfig` fontSize) <$> maybeFontFamily
  
  -- | This data type represents an option that can either be 'Set' or 'Unset'.
  --
  -- This data type is used in situations where leaving an option unset results
  -- in a special state that is not representable by setting any specific value.
  --
  -- Examples of this include the 'cursorFgColour' and 'cursorBgColour' options
  -- supplied by the 'ColourConfig' @ConfigExtension@.  By default,
  -- 'cursorFgColour' and 'cursorBgColour' are both 'Unset'.  However, when
  -- 'cursorBgColour' is 'Set', 'cursorFgColour' defaults to the color of the text
  -- underneath.  There is no way to represent this by explicitly setting
  -- 'cursorFgColour'.
  data Option a = Unset | Set !a
    deriving (Show, Read, Eq, Ord, Functor, Foldable)
  
  -- | Run a function over the value contained in an 'Option'. Return 'mempty'
  -- when 'Option' is 'Unset'.
  --
  -- >>> whenSet (Set [1,2,3]) (++ [4,5,6]) :: [Int]
  -- [1,2,3,4,5,6]
  -- >>> whenSet Unset (++ [4,5,6]) :: [Int]
  -- []
  whenSet :: Monoid m => Option a -> (a -> m) -> m
  whenSet = \case
    Unset -> const mempty
    Set x -> \f -> f x
  
  -- | Whether or not to show the scroll bar in a terminal.
  data ShowScrollbar
    = ShowScrollbarNever -- ^ Never show the scroll bar, even if there are too
                         -- many lines on the terminal to show all at once.  You
                         -- should still be able to scroll with the mouse wheel.
    | ShowScrollbarAlways -- ^ Always show the scrollbar, even if it is not
                          -- needed.
    | ShowScrollbarIfNeeded -- ^ Only show the scrollbar if there are too many
                            -- lines on the terminal to show all at once.
    deriving (Enum, Eq, Generic, FromJSON, Show, ToJSON)
  
  showScrollbarToString :: ShowScrollbar -> Text
  showScrollbarToString = \case
    ShowScrollbarNever -> "never"
    ShowScrollbarAlways -> "always"
    ShowScrollbarIfNeeded -> "if-needed"
  
  showScrollbarFromString :: Text -> Maybe ShowScrollbar
  showScrollbarFromString = \case
    "never" -> Just ShowScrollbarNever
    "always" -> Just ShowScrollbarAlways
    "if-needed" -> Just ShowScrollbarIfNeeded
    _ -> Nothing
  
  -- | Whether or not to show the tab bar for switching tabs.
  data ShowTabBar
    = ShowTabBarNever -- ^ Never show the tab bar, even if there are multiple tabs
                      -- open.  This may be confusing if you plan on using multiple tabs.
    | ShowTabBarAlways -- ^ Always show the tab bar, even if you only have one tab open.
    | ShowTabBarIfNeeded  -- ^ Only show the tab bar if you have multiple tabs open.
    deriving (Enum, Eq, Generic, FromJSON, Show, ToJSON)
  
  showTabBarToString :: ShowTabBar -> Text
  showTabBarToString = \case
    ShowTabBarNever -> "never"
    ShowTabBarAlways -> "always"
    ShowTabBarIfNeeded -> "if-needed"
  
  showTabBarFromString :: Text -> Maybe ShowTabBar
  showTabBarFromString = \case
    "never" -> Just ShowTabBarNever
    "always" -> Just ShowTabBarAlways
    "if-needed" -> Just ShowTabBarIfNeeded
    _ -> Nothing
  
  -- | Configuration options for Termonad.
  --
  -- See 'defaultConfigOptions' for the default values.
  data ConfigOptions = ConfigOptions
    { fontConfig :: !FontConfig
      -- ^ Specific options for fonts.
    , showScrollbar :: !ShowScrollbar
      -- ^ When to show the scroll bar.
    , scrollbackLen :: !Integer
      -- ^ The number of lines to keep in the scroll back history for each terminal.
    , confirmExit :: !Bool
      -- ^ Whether or not to ask you for confirmation when closing individual
      -- terminals or Termonad itself.  It is generally safer to keep this as
      -- 'True'.
    , wordCharExceptions :: !Text
      -- ^ When double-clicking on text in the terminal with the mouse, Termonad
      -- will use this value to determine what to highlight.  The individual
      -- characters in this list will be counted as part of a word.
      --
      -- For instance if 'wordCharExceptions' is @""@, then when you double-click
      -- on the text @http://@, only the @http@ portion will be highlighted.  If
      -- 'wordCharExceptions' is @":"@, then the @http:@ portion will be
      -- highlighted.
    , showMenu :: !Bool
      -- ^ Whether or not to show the @File@ @Edit@ etc menu.
    , showTabBar :: !ShowTabBar
      -- ^ When to show the tab bar.
    , cursorBlinkMode :: !CursorBlinkMode
      -- ^ How to handle cursor blink.
    , boldIsBright :: !Bool
      -- ^ This option controls whether or not to force bold text to use colors
      -- from the 'Termonad.Config.Colour.ExtendedPalatte'.
      --
      -- If 'True', then colored bold text will /always/ use colors from the
      -- 'Termonad.Config.Colour.ExtendedPalatte'.  There will be no way to print
      -- bold text colored with the 'Termonad.Config.Colour.BasicPalatte'.
      --
      -- This often isn't a big problem, since many TUI applications use
      -- bold in combination with colors from the 'Termonad.Config.Colour.ExtendedPalatte'.
      -- Also, the VTE default blue color can be difficult to read with a dark
      -- background, and enabling this can work around the problem.
      -- See <https://github.com/cdepillabout/termonad/issues/177> for more information.
      --
      -- If 'False', then bold can be applied separately to colors from both the
      -- 'Termonad.Config.Colour.BasicPalatte' and
      -- 'Termonad.Config.Colour.ExtendedPalatte'.
    , enableSixel :: !Bool
      -- ^ Enable SIXEL to draw graphics in a terminal.
      --
      -- In order for this option to do anything, you need to be using a version
      -- of VTE >= 0.63, and compile VTE with SIXEL support.
      --
      -- Note that even if you do the above, there may still be some problems
      -- with SIXEL support in VTE. Follow
      -- <https://gitlab.gnome.org/GNOME/vte/-/issues/253> for more information.
    , allowBold :: !Bool
      -- ^ Allow terminal to use bold text.
      --
      -- You may want to disable this, for instance, if you use a font that
      -- doesn't look good when bold.
    } deriving (Eq, Generic, FromJSON, Show, ToJSON)
  
  cursorBlinkModeToString :: CursorBlinkMode -> Text
  cursorBlinkModeToString = \case
    CursorBlinkModeSystem -> "system"
    CursorBlinkModeOn -> "on"
    CursorBlinkModeOff -> "off"
    AnotherCursorBlinkMode _ -> "other"
  
  cursorBlinkModeFromString :: Text -> Maybe CursorBlinkMode
  cursorBlinkModeFromString = \case
    "system" -> Just CursorBlinkModeSystem
    "on" -> Just CursorBlinkModeOn
    "off" -> Just CursorBlinkModeOff
    _ -> Nothing
  
  instance FromJSON CursorBlinkMode where
    parseJSON = withText "CursorBlinkMode" $ \c -> do
      case (c :: Text) of
        "CursorBlinkModeSystem" -> pure CursorBlinkModeSystem
        "CursorBlinkModeOn" -> pure CursorBlinkModeOn
        "CursorBlinkModeOff" -> pure CursorBlinkModeOff
        _ -> fail "Wrong value for CursorBlinkMode"
  
  instance ToJSON CursorBlinkMode where
    toJSON CursorBlinkModeSystem = String "CursorBlinkModeSystem"
    toJSON CursorBlinkModeOn = String "CursorBlinkModeOn"
    toJSON CursorBlinkModeOff = String "CursorBlinkModeOff"
    -- Not supposed to happened fall back to system
    toJSON (AnotherCursorBlinkMode _) = String "CursorBlinkModeSystem"
  
  -- | The default 'ConfigOptions'.
  --
  -- >>> :{
  --   let defConfOpt =
  --         ConfigOptions
  --           { fontConfig = defaultFontConfig
  --           , showScrollbar = ShowScrollbarIfNeeded
  --           , scrollbackLen = 10000
  --           , confirmExit = True
  --           , wordCharExceptions = "-#%&+,./=?@\\_~\183:"
  --           , showMenu = True
  --           , showTabBar = ShowTabBarIfNeeded
  --           , cursorBlinkMode = CursorBlinkModeOn
  --           , boldIsBright = False
  --           , enableSixel = False
  --           , allowBold = True
  --           }
  --   in defaultConfigOptions == defConfOpt
  -- :}
  -- True
  defaultConfigOptions :: ConfigOptions
  defaultConfigOptions =
    ConfigOptions
      { fontConfig = defaultFontConfig
      , showScrollbar = ShowScrollbarIfNeeded
      , scrollbackLen = 10000
      , confirmExit = True
      , wordCharExceptions = "-#%&+,./=?@\\_~\183:"
      , showMenu = True
      , showTabBar = ShowTabBarIfNeeded
      , cursorBlinkMode = CursorBlinkModeOn
      , boldIsBright = False
      , enableSixel = False
      , allowBold = True
      }
  
  -- | The Termonad 'ConfigOptions' along with the 'ConfigHooks'.
  data TMConfig = TMConfig
    { options :: !ConfigOptions
    , hooks :: !ConfigHooks
    } deriving Show
  
  -- | The default 'TMConfig'.
  --
  -- 'options' is 'defaultConfigOptions' and 'hooks' is 'defaultConfigHooks'.
  defaultTMConfig :: TMConfig
  defaultTMConfig =
    TMConfig
      { options = defaultConfigOptions
      , hooks = defaultConfigHooks
      }
  
  ---------------------
  -- ConfigHooks --
  ---------------------
  
  -- | Hooks into certain termonad operations and VTE events. Used to modify
  -- termonad's behaviour in order to implement new functionality. Fields should
  -- have sane @Semigroup@ and @Monoid@ instances so that config extensions can
  -- be combined uniformly and new hooks can be added without incident.
  newtype ConfigHooks = ConfigHooks {
    -- | Produce an IO action to run on creation of new @Terminal@, given @TMState@
    -- and the @Terminal@ in question.
    createTermHook :: TMState -> Terminal -> IO ()
  }
  
  instance Show ConfigHooks where
    showsPrec :: Int -> ConfigHooks -> ShowS
    showsPrec _ _ =
      showString "ConfigHooks {" .
      showString "createTermHook = <function>" .
      showString "}"
  
  -- | Default values for the 'ConfigHooks'.
  --
  -- - The default function for 'createTermHook' is 'defaultCreateTermHook'.
  defaultConfigHooks :: ConfigHooks
  defaultConfigHooks =
    ConfigHooks
      { createTermHook = defaultCreateTermHook
      }
  
  -- | Default value for 'createTermHook'.  Does nothing.
  defaultCreateTermHook :: TMState -> Terminal -> IO ()
  defaultCreateTermHook _ _ = pure ()
  
  ----------------
  -- Invariants --
  ----------------
  
  data FocusNotSameErr
    = FocusListFocusExistsButNoNotebookTabWidget
    | NotebookTabWidgetDiffersFromFocusListFocus
    | NotebookTabWidgetExistsButNoFocusListFocus
    deriving Show
  
  data TabsDoNotMatch
    = TabLengthsDifferent Int Int -- ^ The first 'Int' is the number of tabs in the
                                  -- actual GTK 'Notebook'.  The second 'Int' is
                                  -- the number of tabs in the 'FocusList'.
    | TabAtIndexDifferent Int     -- ^ The tab at index 'Int' is different between
                                  -- the actual GTK 'Notebook' and the 'FocusList'.
    deriving (Show)
  
  -- | An invariant error on a given 'TMWindow'.
  data TMWinInvariantErr
    = FocusNotSame FocusNotSameErr Int
    | TabsDoNotMatch TabsDoNotMatch
    deriving Show
  
  -- | An invariant error on a whole 'TMState'.
  data TMStateInvariantErr
    = TMWinInvariantErr Int TMWinInvariantErr
      -- ^ An invariant error with a given 'TMWindow'.  The 'Int' indicates
      -- which window it is as an index into 'tmStateWindows'.
    deriving Show
  
  invariantTMWindow :: TMWindow -> IO [TMWinInvariantErr]
  invariantTMWindow tmWin =
    runInvariants
      [ invariantFocusSame
      , invariantTMTabLength
      , invariantTabsAllMatch
      ]
    where
      runInvariants :: [IO (Maybe TMWinInvariantErr)] -> IO [TMWinInvariantErr]
      runInvariants = fmap catMaybes . sequence
  
      invariantFocusSame :: IO (Maybe TMWinInvariantErr)
      invariantFocusSame = do
        let tmNote = tmNotebook $ tmWindowNotebook tmWin
        index32 <- notebookGetCurrentPage tmNote
        maybeWidgetFromNote <- notebookGetNthPage tmNote index32
        let focusList = tmNotebookTabs $ tmWindowNotebook tmWin
            maybeScrollWinFromFL =
              tmNotebookTabTermContainer <$> getFocusItemFL focusList
            idx = fromIntegral index32
        case (maybeWidgetFromNote, maybeScrollWinFromFL) of
          (Nothing, Nothing) -> pure Nothing
          (Just _, Nothing) ->
            pure $
              Just $
                FocusNotSame NotebookTabWidgetExistsButNoFocusListFocus idx
          (Nothing, Just _) ->
            pure $
              Just $
                FocusNotSame FocusListFocusExistsButNoNotebookTabWidget idx
          (Just widgetFromNote, Just scrollWinFromFL) -> do
            isEq <- widgetEq widgetFromNote scrollWinFromFL
            if isEq
              then pure Nothing
              else
                pure $
                  Just $
                    FocusNotSame NotebookTabWidgetDiffersFromFocusListFocus idx
  
      invariantTMTabLength :: IO (Maybe TMWinInvariantErr)
      invariantTMTabLength = do
        let tmNote = tmNotebook $ tmWindowNotebook tmWin
        noteLength32 <- notebookGetNPages tmNote
        let noteLength = fromIntegral noteLength32
            focusListLength = lengthFL $ tmNotebookTabs $ tmWindowNotebook tmWin
            lengthEqual = focusListLength == noteLength
        if lengthEqual
          then pure Nothing
          else  pure $
                 Just $
                  TabsDoNotMatch $
                   TabLengthsDifferent noteLength focusListLength
  
      -- Turns a FocusList and Notebook into two lists of widgets and compares each widget for equality
      invariantTabsAllMatch :: IO (Maybe TMWinInvariantErr)
      invariantTabsAllMatch = do
        let tmNote = tmNotebook $ tmWindowNotebook tmWin
            focusList = tmNotebookTabs $ tmWindowNotebook tmWin
            flList = tmNotebookTabTermContainer <$> toList focusList
        noteList <- notebookToList tmNote
        tabsMatch noteList flList
        where
          tabsMatch
            :: forall a b
             . (IsWidget a, IsWidget b)
            => [a]
            -> [b]
            -> IO (Maybe TMWinInvariantErr)
          tabsMatch xs ys = foldr go (pure Nothing) (zip3 xs ys [0..])
            where
              go :: (a, b, Int) -> IO (Maybe TMWinInvariantErr) -> IO (Maybe TMWinInvariantErr)
              go (x, y, i) acc = do
                isEq <- widgetEq x y
                if isEq
                  then acc
                  else pure . Just $ TabsDoNotMatch (TabAtIndexDifferent i)
  
  -- | Gather up the invariants for 'TMState' and return them as a list.
  --
  -- If no invariants have been violated, then this function should return an
  -- empty list.
  invariantTMState' :: TMState' -> IO [TMStateInvariantErr]
  invariantTMState' tmState = do
    let tmWindows = tmStateWindows tmState
    ifoldMap go tmWindows
    where
      go :: Int -> TMWindow -> IO [TMStateInvariantErr]
      go idx tmWin = do
        tmWinErrs <- invariantTMWindow tmWin
        pure $ fmap (TMWinInvariantErr idx) tmWinErrs
  
  -- | Check the invariants for 'TMState', and call 'fail' if we find that they
  -- have been violated.
  assertInvariantTMState :: TMState -> IO ()
  assertInvariantTMState mvarTMState = do
    tmState <- readMVar mvarTMState
    assertValue <- invariantTMState' tmState
    case assertValue of
      [] x-> pure ()
      errs@(_:_) -> do
        putStrLn "In assertInvariantTMState, some invariants for TMState are being violated."
        putStrLn "\nInvariants violated:"
        print errs
        putStrLn "\nTMState:"
        pPrint tmState
        putStrLn ""
        fail "Invariants violated for TMState"
  
  pPrintTMState :: TMState -> IO ()
  pPrintTMState mvarTMState = do
    tmState <- readMVar mvarTMState
    pPrint tmState
  
  traceShowMTMState :: TMState -> IO ()
  traceShowMTMState mvarTMState = do
    tmState <- readMVar mvarTMState
    print tmState
  