content: {-# LANGUAGE CPP #-}
  
  -- | Description : Controls the Preferences dialog and setting app preferences
  -- Copyright     : (c) Dennis Gosnell, 2023
  -- License       : BSD3
  -- Stability     : experimental
  -- Portability   : POSIX
  --
  -- This module controls the Preferences dialog, which lets you set Termonad
  -- preferences at run-time.
  --
  -- It also exports helpful functions from "Termonad.Preferences.File".
  
  module Termonad.Preferences
    ( module Termonad.Preferences.File
    , showPreferencesDialog
    ) where
  
  import Termonad.Prelude
  
  import Control.Lens ((^.), over, set, view)
  import qualified Data.List as List
  import qualified Data.Text as Text
  import GI.Gtk
    ( CheckButton(CheckButton)
    , ComboBoxText(ComboBoxText)
    , Dialog(Dialog)
    , Entry(Entry)
    , FontButton(FontButton)
    , Label(Label)
    , PolicyType(PolicyTypeAutomatic)
    , ResponseType(ResponseTypeAccept)
    , SpinButton(SpinButton)
    , adjustmentNew
    , applicationGetActiveWindow
    , applicationWindowSetShowMenubar
    , builderNewFromString
    , comboBoxGetActiveId
    , comboBoxSetActiveId
    , comboBoxTextAppend
    , dialogRun
    , entryBufferGetText
    , entryBufferSetText
    , fontChooserSetFontDesc
    , fontChooserGetFontDesc
    , getEntryBuffer
    , scrolledWindowSetPolicy
    , spinButtonGetValueAsInt
    , spinButtonSetAdjustment
    , spinButtonSetValue
    , toggleButtonGetActive
    , toggleButtonSetActive
    , widgetDestroy
    , widgetSetVisible
    , windowSetTransientFor
    )
  import GI.Vte
    ( CursorBlinkMode(..)
    , terminalSetBoldIsBright
    , terminalSetCursorBlinkMode
    , terminalSetFont
    , terminalSetScrollbackLines
    , terminalSetWordCharExceptions
    , terminalSetAllowBold
    )
  import System.Environment (getExecutablePath)
  import System.FilePath (takeFileName)
  import Termonad.Gtk (objFromBuildUnsafe, terminalSetEnableSixelIfExists)
  import Termonad.Lenses
    ( lensBoldIsBright
    , lensEnableSixel
    , lensAllowBold
    , lensConfirmExit
    , lensCursorBlinkMode
    , lensFontConfig
    , lensOptions
    , lensShowMenu
    , lensShowScrollbar
    , lensShowTabBar
    , lensScrollbackLen
    , lensTMNotebookTabTermContainer
    , lensTMNotebookTabTerm
    , lensTMStateApp
    , lensTMStateConfig
    , lensTMStateFontDesc
    , lensTerm
    , lensWordCharExceptions
    )
  import Termonad.Preferences.File (saveToPreferencesFile, tmConfigFromPreferencesFile)
  import Termonad.Term
    ( setShowTabs
    , showScrollbarToPolicy
    )
  import Termonad.Types
    ( ConfigOptions(..)
    , ShowScrollbar(..)
    , ShowTabBar(..)
    , TMNotebookTab
    , TMState
    , TMWindowId
    , fontConfigFromFontDescription
    , getTMWindowFromTMState'
    , tmNotebook
    , tmNotebookTabs
    , tmStateWindows
    , tmWindowAppWin
    , tmWindowNotebook
    )
  import Termonad.XML (preferencesText)
  import Termonad.IdMap (keysIdMap)
  
  -- | Fill a combo box with ids and labels
  --
  -- The ids are stored in the combobox as 'Text', so their type should be an
  -- instance of the 'Show' type class.
  comboBoxFill :: forall a. Show a => ComboBoxText -> [(a, Text)] -> IO ()
  comboBoxFill comboBox = mapM_ go
    where
      go :: (a, Text) -> IO ()
      go (value, textId) =
        comboBoxTextAppend comboBox (Just $ tshow value) textId
  
  -- | Set the current active item in a combobox given an input id.
  comboBoxSetActive :: Show a => ComboBoxText -> a -> IO ()
  comboBoxSetActive cb item = void $ comboBoxSetActiveId cb (Just $ tshow item)
  
  -- | Get the current active item in a combobox
  --
  -- The list of values to be searched in the combobox must be given as a
  -- parameter. These values are converted to Text then compared to the current
  -- id.
  comboBoxGetActive
    :: forall a. (Show a, Enum a) => ComboBoxText -> [a] -> IO (Maybe a)
  comboBoxGetActive cb values = findEnumFromMaybeId <$> comboBoxGetActiveId cb
    where
      findEnumFromMaybeId :: Maybe Text -> Maybe a
      findEnumFromMaybeId maybeId = maybeId >>= findEnumFromId
  
      findEnumFromId :: Text -> Maybe a
      findEnumFromId label = List.find (\x -> tshow x == label) values
  
  applyNewPreferencesToTab :: TMState -> TMNotebookTab -> IO ()
  applyNewPreferencesToTab mvarTMState tab = do
    tmState <- readMVar mvarTMState
    let fontDesc = tmState ^. lensTMStateFontDesc
        term = tab ^. lensTMNotebookTabTerm . lensTerm
        scrolledWin = tab ^. lensTMNotebookTabTermContainer
        options = tmState ^. lensTMStateConfig . lensOptions
    terminalSetFont term (Just fontDesc)
    terminalSetCursorBlinkMode term (cursorBlinkMode options)
    terminalSetWordCharExceptions term (wordCharExceptions options)
    terminalSetScrollbackLines term (fromIntegral (scrollbackLen options))
    terminalSetBoldIsBright term (boldIsBright options)
    terminalSetEnableSixelIfExists term (enableSixel options)
    terminalSetAllowBold term (allowBold options)
  
    let vScrollbarPolicy = showScrollbarToPolicy (options ^. lensShowScrollbar)
    scrolledWindowSetPolicy scrolledWin PolicyTypeAutomatic vScrollbarPolicy
  
  applyNewPreferencesToWindow :: TMState -> TMWindowId -> IO ()
  applyNewPreferencesToWindow mvarTMState tmWinId = do
    tmState <- readMVar mvarTMState
    tmWin <- getTMWindowFromTMState' tmState tmWinId
    let appWin = tmWindowAppWin tmWin
        config = tmState ^. lensTMStateConfig
        notebook = tmWindowNotebook tmWin
        tabFocusList = tmNotebookTabs notebook
        showMenu = config  ^. lensOptions . lensShowMenu
    applicationWindowSetShowMenubar appWin showMenu
    setShowTabs config (tmNotebook notebook)
    -- Sets the remaining preferences to each tab
    foldMap (applyNewPreferencesToTab mvarTMState) tabFocusList
  
  -- | Takes a 'TMState', and looks at the 'TMConfig' within.
  -- Take all the configuration options from the 'TMConfig' and apply them to the
  -- current 'Application', 'Window's, and 'Term's.
  --
  -- This function is meant to be used after a big update to the 'TMConfig' within a
  -- 'TMState'.
  applyNewPreferences :: TMState -> IO ()
  applyNewPreferences mvarTMState = do
    tmState <- readMVar mvarTMState
    let windows = tmStateWindows tmState
    foldMap (applyNewPreferencesToWindow mvarTMState) (keysIdMap windows)
  
  -- | Show the preferences dialog.
  --
  -- When the user clicks on the Ok button, it copies the new settings to TMState.
  -- Then apply them to the current terminals.
  showPreferencesDialog :: TMState -> IO ()
  showPreferencesDialog mvarTMState = do
    -- Get app out of mvar
    tmState <- readMVar mvarTMState
    let app = tmState ^. lensTMStateApp
  
    -- Create the preference dialog and get some widgets
    preferencesBuilder <-
      builderNewFromString preferencesText $ fromIntegral (Text.length preferencesText)
    preferencesDialog <-
      objFromBuildUnsafe preferencesBuilder "preferences" Dialog
    confirmExitCheckButton <-
      objFromBuildUnsafe preferencesBuilder "confirmExit" CheckButton
    showMenuCheckButton <-
      objFromBuildUnsafe preferencesBuilder "showMenu" CheckButton
    boldIsBrightCheckButton <-
      objFromBuildUnsafe preferencesBuilder "boldIsBright" CheckButton
    enableSixelCheckButton <-
      objFromBuildUnsafe preferencesBuilder "enableSixel" CheckButton
    allowBoldCheckButton <-
      objFromBuildUnsafe preferencesBuilder "allowBold" CheckButton
    wordCharExceptionsEntryBuffer <-
      objFromBuildUnsafe preferencesBuilder "wordCharExceptions" Entry >>=
        getEntryBuffer
    fontButton <- objFromBuildUnsafe preferencesBuilder "font" FontButton
    showScrollbarComboBoxText <-
      objFromBuildUnsafe preferencesBuilder "showScrollbar" ComboBoxText
    comboBoxFill
      showScrollbarComboBoxText
      [ (ShowScrollbarNever, "Never")
      , (ShowScrollbarAlways, "Always")
      , (ShowScrollbarIfNeeded, "If needed")
      ]
    showTabBarComboBoxText <-
      objFromBuildUnsafe preferencesBuilder "showTabBar" ComboBoxText
    comboBoxFill
      showTabBarComboBoxText
      [ (ShowTabBarNever, "Never")
      , (ShowTabBarAlways, "Always")
      , (ShowTabBarIfNeeded, "If needed")
      ]
    cursorBlinkModeComboBoxText <-
      objFromBuildUnsafe preferencesBuilder "cursorBlinkMode" ComboBoxText
    comboBoxFill
      cursorBlinkModeComboBoxText
      [ (CursorBlinkModeSystem, "System")
      , (CursorBlinkModeOn, "On")
      , (CursorBlinkModeOff, "Off")
      ]
    scrollbackLenSpinButton <-
      objFromBuildUnsafe preferencesBuilder "scrollbackLen" SpinButton
    adjustmentNew 0 0 (fromIntegral (maxBound :: Int)) 1 10 0 >>=
      spinButtonSetAdjustment scrollbackLenSpinButton
    warningLabel <- objFromBuildUnsafe preferencesBuilder "warning" Label
  
    -- We show the warning label only if the user has launched termonad with a
    -- termonad.hs file
    executablePath <- getExecutablePath
    let hasTermonadHs = takeFileName executablePath == "termonad-linux-x86_64"
    widgetSetVisible warningLabel hasTermonadHs
  
    -- Make the dialog modal
    maybeWin <- applicationGetActiveWindow app
    windowSetTransientFor preferencesDialog maybeWin
  
    -- Init with current state
    fontChooserSetFontDesc fontButton (tmState ^. lensTMStateFontDesc)
    let options = tmState ^. lensTMStateConfig . lensOptions
    comboBoxSetActive showScrollbarComboBoxText $ showScrollbar options
    comboBoxSetActive showTabBarComboBoxText $ showTabBar options
    comboBoxSetActive cursorBlinkModeComboBoxText $ cursorBlinkMode options
    spinButtonSetValue scrollbackLenSpinButton (fromIntegral $ scrollbackLen options)
    toggleButtonSetActive confirmExitCheckButton $ confirmExit options
    toggleButtonSetActive showMenuCheckButton $ showMenu options
    toggleButtonSetActive boldIsBrightCheckButton $ boldIsBright options
    toggleButtonSetActive enableSixelCheckButton $ enableSixel options
    toggleButtonSetActive allowBoldCheckButton $ allowBold options
    entryBufferSetText wordCharExceptionsEntryBuffer (wordCharExceptions options) (-1)
  
    -- Run dialog then close
    res <- dialogRun preferencesDialog
  
    -- When closing the dialog get the new settings
    when (toEnum (fromIntegral res) == ResponseTypeAccept) $ do
      maybeFontDesc <- fontChooserGetFontDesc fontButton
      maybeFontConfig <-
        join <$> mapM fontConfigFromFontDescription maybeFontDesc
      maybeShowScrollbar <-
        comboBoxGetActive showScrollbarComboBoxText [ShowScrollbarNever ..]
      maybeShowTabBar <-
        comboBoxGetActive showTabBarComboBoxText [ShowTabBarNever ..]
      maybeCursorBlinkMode <-
        comboBoxGetActive cursorBlinkModeComboBoxText [CursorBlinkModeSystem ..]
      scrollbackLenVal <-
        fromIntegral <$> spinButtonGetValueAsInt scrollbackLenSpinButton
      confirmExitVal <- toggleButtonGetActive confirmExitCheckButton
      showMenuVal <- toggleButtonGetActive showMenuCheckButton
      boldIsBrightVal <- toggleButtonGetActive boldIsBrightCheckButton
      enableSixelVal <- toggleButtonGetActive enableSixelCheckButton
      allowBoldVal <- toggleButtonGetActive allowBoldCheckButton
      wordCharExceptionsVal <- entryBufferGetText wordCharExceptionsEntryBuffer
  
      -- Apply the changes to mvarTMState
      modifyMVar_ mvarTMState $ pure
        . over lensTMStateFontDesc (`fromMaybe` maybeFontDesc)
        . over (lensTMStateConfig . lensOptions)
          ( set lensConfirmExit confirmExitVal
          . set lensShowMenu showMenuVal
          . set lensBoldIsBright boldIsBrightVal
          . set lensEnableSixel enableSixelVal
          . set lensAllowBold allowBoldVal
          . set lensWordCharExceptions wordCharExceptionsVal
          . over lensFontConfig (`fromMaybe` maybeFontConfig)
          . set lensScrollbackLen scrollbackLenVal
          . over lensShowScrollbar (`fromMaybe` maybeShowScrollbar)
          . over lensShowTabBar (`fromMaybe` maybeShowTabBar)
          . over lensCursorBlinkMode (`fromMaybe` maybeCursorBlinkMode)
          )
  
      -- Save the changes to the preferences files
      withMVar mvarTMState $ saveToPreferencesFile . view lensTMStateConfig
  
      -- Update the app with new settings
      applyNewPreferences mvarTMState
  
    widgetDestroy preferencesDialog
  