{-# 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
  { TMTerm -> Terminal
term :: !Terminal
    -- ^ The actual 'Terminal'.
  , TMTerm -> Int
pid :: !Int
    -- ^ The process ID of the process running in 'term'.
  , TMTerm -> Unique
unique :: !Unique
    -- ^ A 'Unique' for comparing different 'TMTerm' for uniqueness.
  }

instance Show TMTerm where
  showsPrec :: Int -> TMTerm -> ShowS
  showsPrec :: Int -> TMTerm -> ShowS
showsPrec Int
d TMTerm{Int
Unique
Terminal
term :: TMTerm -> Terminal
pid :: TMTerm -> Int
unique :: TMTerm -> Unique
term :: Terminal
pid :: Int
unique :: Unique
..} =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"TMTerm {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"term = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"(GI.GTK.Terminal)" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"pid = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
pid ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"unique = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> Int -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Unique -> Int
hashUnique Unique
unique) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"}"

-- | 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
  { TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer :: !ScrolledWindow
    -- ^ The 'ScrolledWindow' holding the VTE 'Terminal'.
  , TMNotebookTab -> TMTerm
tmNotebookTabTerm :: !TMTerm
    -- ^ The 'Terminal' insidie the 'ScrolledWindow'.
  , TMNotebookTab -> Label
tmNotebookTabLabel :: !Label
    -- ^ The 'Label' holding the title of the 'Terminal' in the 'Notebook' tab.
  }

instance Show TMNotebookTab where
  showsPrec :: Int -> TMNotebookTab -> ShowS
  showsPrec :: Int -> TMNotebookTab -> ShowS
showsPrec Int
d TMNotebookTab{ScrolledWindow
Label
TMTerm
tmNotebookTabTermContainer :: TMNotebookTab -> ScrolledWindow
tmNotebookTabTerm :: TMNotebookTab -> TMTerm
tmNotebookTabLabel :: TMNotebookTab -> Label
tmNotebookTabTermContainer :: ScrolledWindow
tmNotebookTabTerm :: TMTerm
tmNotebookTabLabel :: Label
..} =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"TMNotebookTab {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmNotebookTabTermContainer = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"(GI.GTK.ScrolledWindow)" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmNotebookTabTerm = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> TMTerm -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TMTerm
tmNotebookTabTerm ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmNotebookTabLabel = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"(GI.GTK.Label)" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"}"

-- | 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
tmNotebook :: !Notebook
    -- ^ This is the GTK 'Notebook' that holds multiple tabs of 'Terminal's.
  , TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs :: !(FocusList TMNotebookTab)
    -- ^ A 'FocusList' containing references to each individual 'TMNotebookTab'.
  }

instance Show TMNotebook where
  showsPrec :: Int -> TMNotebook -> ShowS
  showsPrec :: Int -> TMNotebook -> ShowS
showsPrec Int
d TMNotebook{FocusList TMNotebookTab
Notebook
tmNotebookTabs :: TMNotebook -> FocusList TMNotebookTab
tmNotebook :: TMNotebook -> Notebook
tmNotebook :: Notebook
tmNotebookTabs :: FocusList TMNotebookTab
..} =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"TMNotebook {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmNotebook = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"(GI.GTK.Notebook)" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmNotebookTabs = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> FocusList TMNotebookTab -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) FocusList TMNotebookTab
tmNotebookTabs ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"}"

getNotebookFromTMState :: TMState -> TMWindowId -> IO Notebook
getNotebookFromTMState :: TMState -> TMWindowId -> IO Notebook
getNotebookFromTMState TMState
mvarTMState TMWindowId
tmWinId = do
  TMNotebook
tmNote <- TMState -> TMWindowId -> IO TMNotebook
getTMNotebookFromTMState TMState
mvarTMState TMWindowId
tmWinId
  Notebook -> IO Notebook
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Notebook -> IO Notebook) -> Notebook -> IO Notebook
forall a b. (a -> b) -> a -> b
$ TMNotebook -> Notebook
tmNotebook TMNotebook
tmNote

getNotebookFromTMState' :: TMState' -> TMWindowId -> IO Notebook
getNotebookFromTMState' :: TMState' -> TMWindowId -> IO Notebook
getNotebookFromTMState' TMState'
tmState TMWindowId
tmWinId = do
  TMNotebook
tmNote <- TMState' -> TMWindowId -> IO TMNotebook
getTMNotebookFromTMState' TMState'
tmState TMWindowId
tmWinId
  Notebook -> IO Notebook
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Notebook -> IO Notebook) -> Notebook -> IO Notebook
forall a b. (a -> b) -> a -> b
$ TMNotebook -> Notebook
tmNotebook TMNotebook
tmNote

getTMNotebookFromTMState :: TMState -> TMWindowId -> IO TMNotebook
getTMNotebookFromTMState :: TMState -> TMWindowId -> IO TMNotebook
getTMNotebookFromTMState TMState
mvarTMState TMWindowId
tmWinId = do
  TMWindow
tmWin <- TMState -> TMWindowId -> IO TMWindow
getTMWindowFromTMState TMState
mvarTMState TMWindowId
tmWinId
  TMNotebook -> IO TMNotebook
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TMNotebook -> IO TMNotebook) -> TMNotebook -> IO TMNotebook
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin

getTMNotebookFromTMState' :: TMState' -> TMWindowId -> IO TMNotebook
getTMNotebookFromTMState' :: TMState' -> TMWindowId -> IO TMNotebook
getTMNotebookFromTMState' TMState'
tmState TMWindowId
tmWinId = do
  TMWindow
tmWin <- TMState' -> TMWindowId -> IO TMWindow
getTMWindowFromTMState' TMState'
tmState TMWindowId
tmWinId
  TMNotebook -> IO TMNotebook
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TMNotebook -> IO TMNotebook) -> TMNotebook -> IO TMNotebook
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin

data TMWindow = TMWindow
  { TMWindow -> ApplicationWindow
tmWindowAppWin :: !ApplicationWindow
  , TMWindow -> TMNotebook
tmWindowNotebook :: !TMNotebook
  }

instance Show TMWindow where
  showsPrec :: Int -> TMWindow -> ShowS
  showsPrec :: Int -> TMWindow -> ShowS
showsPrec Int
d TMWindow{ApplicationWindow
TMNotebook
tmWindowNotebook :: TMWindow -> TMNotebook
tmWindowAppWin :: TMWindow -> ApplicationWindow
tmWindowAppWin :: ApplicationWindow
tmWindowNotebook :: TMNotebook
..} =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"TMWindow {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmWindowAppWin = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"(GI.GTK.ApplicationWindow)" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmWindowNotebook = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> TMNotebook -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TMNotebook
tmWindowNotebook ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"}"

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 :: IdMap TMWindow -> TMWindowId -> IO TMWindow
getTMWindowFromWins IdMap TMWindow
tmWins TMWindowId
tmWinId =
  case TMWindowId -> IdMap TMWindow -> Maybe TMWindow
forall a. TMWindowId -> IdMap a -> Maybe a
lookupIdMap TMWindowId
tmWinId IdMap TMWindow
tmWins of
    Maybe TMWindow
Nothing -> [Char] -> IO TMWindow
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO TMWindow) -> [Char] -> IO TMWindow
forall a b. (a -> b) -> a -> b
$ [Char]
"getTMWindowFromWins: trying to get id " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> TMWindowId -> [Char]
forall a. Show a => a -> [Char]
show TMWindowId
tmWinId [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char]
" from wins, but doesn't exist: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> IdMap TMWindow -> [Char]
forall a. Show a => a -> [Char]
show IdMap TMWindow
tmWins
    Just TMWindow
tmWin -> TMWindow -> IO TMWindow
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TMWindow
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 :: TMState -> TMWindowId -> IO TMWindow
getTMWindowFromTMState TMState
mvarTMState TMWindowId
tmWinId = do
  TMState{IdMap TMWindow
tmStateWindows :: IdMap TMWindow
tmStateWindows :: TMState' -> IdMap TMWindow
tmStateWindows} <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
  IdMap TMWindow -> TMWindowId -> IO TMWindow
getTMWindowFromWins IdMap TMWindow
tmStateWindows TMWindowId
tmWinId

getTMWindowFromTMState' :: TMState' -> TMWindowId -> IO TMWindow
getTMWindowFromTMState' :: TMState' -> TMWindowId -> IO TMWindow
getTMWindowFromTMState' TMState'
tmState TMWindowId
tmWinId =
  IdMap TMWindow -> TMWindowId -> IO TMWindow
getTMWindowFromWins (TMState' -> IdMap TMWindow
tmStateWindows TMState'
tmState) TMWindowId
tmWinId

data TMState' = TMState
  { TMState' -> Application
tmStateApp :: !Application
  , TMState' -> TMConfig
tmStateConfig :: !TMConfig
  , TMState' -> FontDescription
tmStateFontDesc :: !FontDescription
  , TMState' -> IdMap TMWindow
tmStateWindows :: !(IdMap TMWindow)
  }

instance Show TMState' where
  showsPrec :: Int -> TMState' -> ShowS
  showsPrec :: Int -> TMState' -> ShowS
showsPrec Int
d TMState{Application
FontDescription
IdMap TMWindow
TMConfig
tmStateWindows :: TMState' -> IdMap TMWindow
tmStateApp :: TMState' -> Application
tmStateConfig :: TMState' -> TMConfig
tmStateFontDesc :: TMState' -> FontDescription
tmStateApp :: Application
tmStateConfig :: TMConfig
tmStateFontDesc :: FontDescription
tmStateWindows :: IdMap TMWindow
..} =
    Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      [Char] -> ShowS
showString [Char]
"TMState {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmStateApp = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"(GI.GTK.Application)" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmStateConfig = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> TMConfig -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) TMConfig
tmStateConfig ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmStateFontDesc = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"(GI.Pango.FontDescription)" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
", " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"tmStateWindows = " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      Int -> IdMap TMWindow -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) IdMap TMWindow
tmStateWindows ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      [Char] -> ShowS
showString [Char]
"}"

type TMState = MVar TMState'

instance Eq TMTerm where
  (==) :: TMTerm -> TMTerm -> Bool
  == :: TMTerm -> TMTerm -> Bool
(==) = Unique -> Unique -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Unique -> Unique -> Bool)
-> (TMTerm -> Unique) -> TMTerm -> TMTerm -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (TMTerm -> Unique
unique :: TMTerm -> Unique)

instance Eq TMNotebookTab where
  (==) :: TMNotebookTab -> TMNotebookTab -> Bool
  == :: TMNotebookTab -> TMNotebookTab -> Bool
(==) = TMTerm -> TMTerm -> Bool
forall a. Eq a => a -> a -> Bool
(==) (TMTerm -> TMTerm -> Bool)
-> (TMNotebookTab -> TMTerm)
-> TMNotebookTab
-> TMNotebookTab
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` TMNotebookTab -> TMTerm
tmNotebookTabTerm

createTMTerm :: Terminal -> Int -> Unique -> TMTerm
createTMTerm :: Terminal -> Int -> Unique -> TMTerm
createTMTerm Terminal
trm Int
pd Unique
unq =
  TMTerm
    { term :: Terminal
term = Terminal
trm
    , pid :: Int
pid = Int
pd
    , unique :: Unique
unique = Unique
unq
    }

newTMTerm :: Terminal -> Int -> IO TMTerm
newTMTerm :: Terminal -> Int -> IO TMTerm
newTMTerm Terminal
trm Int
pd = Terminal -> Int -> Unique -> TMTerm
createTMTerm Terminal
trm Int
pd (Unique -> TMTerm) -> IO Unique -> IO TMTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Unique
newUnique

getFocusedTermFromState :: TMState -> TMWindowId -> IO (Maybe Terminal)
getFocusedTermFromState :: TMState -> TMWindowId -> IO (Maybe Terminal)
getFocusedTermFromState TMState
mvarTMState TMWindowId
tmWinId =
  TMState -> (TMState' -> IO (Maybe Terminal)) -> IO (Maybe Terminal)
forall a b. MVar a -> (a -> IO b) -> IO b
withMVar TMState
mvarTMState TMState' -> IO (Maybe Terminal)
go
  where
    go :: TMState' -> IO (Maybe Terminal)
    go :: TMState' -> IO (Maybe Terminal)
go TMState'
tmState = do
      TMNotebook
tmNote <- TMState' -> TMWindowId -> IO TMNotebook
getTMNotebookFromTMState' TMState'
tmState TMWindowId
tmWinId
      let maybeNotebookTab :: Maybe TMNotebookTab
maybeNotebookTab = FocusList TMNotebookTab -> Maybe TMNotebookTab
forall a. FocusList a -> Maybe a
getFocusItemFL (FocusList TMNotebookTab -> Maybe TMNotebookTab)
-> FocusList TMNotebookTab -> Maybe TMNotebookTab
forall a b. (a -> b) -> a -> b
$ TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs TMNotebook
tmNote
      Maybe Terminal -> IO (Maybe Terminal)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Terminal -> IO (Maybe Terminal))
-> Maybe Terminal -> IO (Maybe Terminal)
forall a b. (a -> b) -> a -> b
$ (TMNotebookTab -> Terminal)
-> Maybe TMNotebookTab -> Maybe Terminal
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TMTerm -> Terminal
term (TMTerm -> Terminal)
-> (TMNotebookTab -> TMTerm) -> TMNotebookTab -> Terminal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMNotebookTab -> TMTerm
tmNotebookTabTerm) Maybe TMNotebookTab
maybeNotebookTab

createTMNotebookTab :: Label -> ScrolledWindow -> TMTerm -> TMNotebookTab
createTMNotebookTab :: Label -> ScrolledWindow -> TMTerm -> TMNotebookTab
createTMNotebookTab Label
tabLabel ScrolledWindow
scrollWin TMTerm
trm =
  TMNotebookTab
    { tmNotebookTabTermContainer :: ScrolledWindow
tmNotebookTabTermContainer = ScrolledWindow
scrollWin
    , tmNotebookTabTerm :: TMTerm
tmNotebookTabTerm = TMTerm
trm
    , tmNotebookTabLabel :: Label
tmNotebookTabLabel = Label
tabLabel
    }

createTMNotebook :: Notebook -> FocusList TMNotebookTab -> TMNotebook
createTMNotebook :: Notebook -> FocusList TMNotebookTab -> TMNotebook
createTMNotebook Notebook
note FocusList TMNotebookTab
tabs =
  TMNotebook
    { tmNotebook :: Notebook
tmNotebook = Notebook
note
    , tmNotebookTabs :: FocusList TMNotebookTab
tmNotebookTabs = FocusList TMNotebookTab
tabs
    }

createEmptyTMNotebook :: Notebook -> TMNotebook
createEmptyTMNotebook :: Notebook -> TMNotebook
createEmptyTMNotebook Notebook
notebook = Notebook -> FocusList TMNotebookTab -> TMNotebook
createTMNotebook Notebook
notebook FocusList TMNotebookTab
forall a. FocusList a
emptyFL

notebookToList :: Notebook -> IO [Widget]
notebookToList :: Notebook -> IO [Widget]
notebookToList Notebook
notebook =
  Int32 -> [Widget] -> IO [Widget]
unfoldHelper Int32
0 []
  where unfoldHelper :: Int32 -> [Widget] -> IO [Widget]
        unfoldHelper :: Int32 -> [Widget] -> IO [Widget]
unfoldHelper Int32
index32 [Widget]
acc = do
          Maybe Widget
notePage <- Notebook -> Int32 -> IO (Maybe Widget)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Int32 -> m (Maybe Widget)
notebookGetNthPage Notebook
notebook Int32
index32
          case Maybe Widget
notePage of
            Maybe Widget
Nothing -> [Widget] -> IO [Widget]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Widget]
acc
            Just Widget
notePage' -> Int32 -> [Widget] -> IO [Widget]
unfoldHelper (Int32
index32 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1) ([Widget]
acc [Widget] -> [Widget] -> [Widget]
forall a. [a] -> [a] -> [a]
++ [Item [Widget]
Widget
notePage'])

createTMWindow :: ApplicationWindow -> TMNotebook -> TMWindow
createTMWindow :: ApplicationWindow -> TMNotebook -> TMWindow
createTMWindow ApplicationWindow
appwin TMNotebook
notebook =
  TMWindow
    { tmWindowAppWin :: ApplicationWindow
tmWindowAppWin = ApplicationWindow
appwin
    , tmWindowNotebook :: TMNotebook
tmWindowNotebook = TMNotebook
notebook
    }

newEmptyTMState :: TMConfig -> Application -> ApplicationWindow -> Notebook -> FontDescription -> IO (TMState, TMWindowId)
newEmptyTMState :: TMConfig
-> Application
-> ApplicationWindow
-> Notebook
-> FontDescription
-> IO (TMState, TMWindowId)
newEmptyTMState TMConfig
tmConfig Application
app ApplicationWindow
appWin Notebook
note FontDescription
fontDesc = do
  let tmnote :: TMNotebook
tmnote = Notebook -> TMNotebook
createEmptyTMNotebook Notebook
note
      tmwin :: TMWindow
tmwin = ApplicationWindow -> TMNotebook -> TMWindow
createTMWindow ApplicationWindow
appWin TMNotebook
tmnote
      (TMWindowId
tmwinId, IdMap TMWindow
tmwins) = TMWindow -> (TMWindowId, IdMap TMWindow)
forall a. a -> (TMWindowId, IdMap a)
singletonIdMap TMWindow
tmwin
  TMState
tmState <-
    TMState' -> IO TMState
forall a. a -> IO (MVar a)
newMVar (TMState' -> IO TMState) -> TMState' -> IO TMState
forall a b. (a -> b) -> a -> b
$
      TMState
        { tmStateApp :: Application
tmStateApp = Application
app
        , tmStateConfig :: TMConfig
tmStateConfig = TMConfig
tmConfig
        , tmStateFontDesc :: FontDescription
tmStateFontDesc = FontDescription
fontDesc
        , tmStateWindows :: IdMap TMWindow
tmStateWindows = IdMap TMWindow
tmwins
        }
  (TMState, TMWindowId) -> IO (TMState, TMWindowId)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TMState
tmState, TMWindowId
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 (FontSize -> FontSize -> Bool
(FontSize -> FontSize -> Bool)
-> (FontSize -> FontSize -> Bool) -> Eq FontSize
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontSize -> FontSize -> Bool
== :: FontSize -> FontSize -> Bool
$c/= :: FontSize -> FontSize -> Bool
/= :: FontSize -> FontSize -> Bool
Eq, Value -> Parser [FontSize]
Value -> Parser FontSize
(Value -> Parser FontSize)
-> (Value -> Parser [FontSize]) -> FromJSON FontSize
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FontSize
parseJSON :: Value -> Parser FontSize
$cparseJSONList :: Value -> Parser [FontSize]
parseJSONList :: Value -> Parser [FontSize]
FromJSON, (forall x. FontSize -> Rep FontSize x)
-> (forall x. Rep FontSize x -> FontSize) -> Generic FontSize
forall x. Rep FontSize x -> FontSize
forall x. FontSize -> Rep FontSize x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FontSize -> Rep FontSize x
from :: forall x. FontSize -> Rep FontSize x
$cto :: forall x. Rep FontSize x -> FontSize
to :: forall x. Rep FontSize x -> FontSize
Generic, Int -> FontSize -> ShowS
[FontSize] -> ShowS
FontSize -> [Char]
(Int -> FontSize -> ShowS)
-> (FontSize -> [Char]) -> ([FontSize] -> ShowS) -> Show FontSize
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontSize -> ShowS
showsPrec :: Int -> FontSize -> ShowS
$cshow :: FontSize -> [Char]
show :: FontSize -> [Char]
$cshowList :: [FontSize] -> ShowS
showList :: [FontSize] -> ShowS
Show, [FontSize] -> Value
[FontSize] -> Encoding
FontSize -> Value
FontSize -> Encoding
(FontSize -> Value)
-> (FontSize -> Encoding)
-> ([FontSize] -> Value)
-> ([FontSize] -> Encoding)
-> ToJSON FontSize
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FontSize -> Value
toJSON :: FontSize -> Value
$ctoEncoding :: FontSize -> Encoding
toEncoding :: FontSize -> Encoding
$ctoJSONList :: [FontSize] -> Value
toJSONList :: [FontSize] -> Value
$ctoEncodingList :: [FontSize] -> Encoding
toEncodingList :: [FontSize] -> Encoding
ToJSON)

-- | The default 'FontSize' used if not specified.
--
-- >>> defaultFontSize
-- FontSizePoints 12
defaultFontSize :: FontSize
defaultFontSize :: FontSize
defaultFontSize = Int -> FontSize
FontSizePoints Int
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 :: Int -> FontSize -> FontSize
modFontSize Int
i (FontSizePoints Int
oldPoints) =
  let newPoints :: Int
newPoints = Int
oldPoints Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
  in Int -> FontSize
FontSizePoints (Int -> FontSize) -> Int -> FontSize
forall a b. (a -> b) -> a -> b
$ if Int
newPoints Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 then Int
oldPoints else Int
newPoints
modFontSize Int
i (FontSizeUnits Double
oldUnits) =
  let newUnits :: Double
newUnits = Double
oldUnits Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
  in Double -> FontSize
FontSizeUnits (Double -> FontSize) -> Double -> FontSize
forall a b. (a -> b) -> a -> b
$ if Double
newUnits Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1 then Double
oldUnits else Double
newUnits

fontSizeFromFontDescription :: FontDescription -> IO FontSize
fontSizeFromFontDescription :: FontDescription -> IO FontSize
fontSizeFromFontDescription FontDescription
fontDesc = do
  Int32
currSize <- FontDescription -> IO Int32
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> m Int32
fontDescriptionGetSize FontDescription
fontDesc
  Bool
currAbsolute <- FontDescription -> IO Bool
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> m Bool
fontDescriptionGetSizeIsAbsolute FontDescription
fontDesc
  FontSize -> IO FontSize
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FontSize -> IO FontSize) -> FontSize -> IO FontSize
forall a b. (a -> b) -> a -> b
$
    if Bool
currAbsolute
    then Double -> FontSize
FontSizeUnits (Double -> FontSize) -> Double -> FontSize
forall a b. (a -> b) -> a -> b
$ Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
currSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE
    else
      let Double
fontRatio :: Double = Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
currSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE
      in Int -> FontSize
FontSizePoints (Int -> FontSize) -> Int -> FontSize
forall a b. (a -> b) -> a -> b
$ Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round Double
fontRatio

-- | Create a 'FontDescription' from a 'FontSize' and font family.
createFontDesc
  :: FontSize
  -> Text
  -- ^ font family
  -> IO FontDescription
createFontDesc :: FontSize -> Text -> IO FontDescription
createFontDesc FontSize
fontSz Text
fontFam = do
  FontDescription
fontDesc <- IO FontDescription
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
m FontDescription
fontDescriptionNew
  FontDescription -> Text -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> Text -> m ()
fontDescriptionSetFamily FontDescription
fontDesc Text
fontFam
  FontDescription -> FontSize -> IO ()
setFontDescSize FontDescription
fontDesc FontSize
fontSz
  FontDescription -> IO FontDescription
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FontDescription
fontDesc

-- | Set the size of a 'FontDescription' from a 'FontSize'.
setFontDescSize :: FontDescription -> FontSize -> IO ()
setFontDescSize :: FontDescription -> FontSize -> IO ()
setFontDescSize FontDescription
fontDesc (FontSizePoints Int
points) =
  FontDescription -> Int32 -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> Int32 -> m ()
fontDescriptionSetSize FontDescription
fontDesc (Int32 -> IO ()) -> Int32 -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
points Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE)
setFontDescSize FontDescription
fontDesc (FontSizeUnits Double
units) =
  FontDescription -> Double -> IO ()
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> Double -> m ()
fontDescriptionSetAbsoluteSize FontDescription
fontDesc (Double -> IO ()) -> Double -> IO ()
forall a b. (a -> b) -> a -> b
$ Double
units Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int32 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
SCALE

-- | Create a 'FontDescription' from the 'fontSize' and 'fontFamily' inside a 'TMConfig'.
createFontDescFromConfig :: TMConfig -> IO FontDescription
createFontDescFromConfig :: TMConfig -> IO FontDescription
createFontDescFromConfig TMConfig
tmConfig = do
  let fontConf :: FontConfig
fontConf = ConfigOptions -> FontConfig
fontConfig (TMConfig -> ConfigOptions
options TMConfig
tmConfig)
  FontSize -> Text -> IO FontDescription
createFontDesc (FontConfig -> FontSize
fontSize FontConfig
fontConf) (FontConfig -> Text
fontFamily FontConfig
fontConf)

-- | Settings for the font to be used in Termonad.
data FontConfig = FontConfig
  { FontConfig -> Text
fontFamily :: !Text
    -- ^ The font family to use.  Example: @"DejaVu Sans Mono"@ or @"Source Code Pro"@
  , FontConfig -> FontSize
fontSize :: !FontSize
    -- ^ The font size.
  } deriving (FontConfig -> FontConfig -> Bool
(FontConfig -> FontConfig -> Bool)
-> (FontConfig -> FontConfig -> Bool) -> Eq FontConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontConfig -> FontConfig -> Bool
== :: FontConfig -> FontConfig -> Bool
$c/= :: FontConfig -> FontConfig -> Bool
/= :: FontConfig -> FontConfig -> Bool
Eq, Value -> Parser [FontConfig]
Value -> Parser FontConfig
(Value -> Parser FontConfig)
-> (Value -> Parser [FontConfig]) -> FromJSON FontConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser FontConfig
parseJSON :: Value -> Parser FontConfig
$cparseJSONList :: Value -> Parser [FontConfig]
parseJSONList :: Value -> Parser [FontConfig]
FromJSON, (forall x. FontConfig -> Rep FontConfig x)
-> (forall x. Rep FontConfig x -> FontConfig) -> Generic FontConfig
forall x. Rep FontConfig x -> FontConfig
forall x. FontConfig -> Rep FontConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FontConfig -> Rep FontConfig x
from :: forall x. FontConfig -> Rep FontConfig x
$cto :: forall x. Rep FontConfig x -> FontConfig
to :: forall x. Rep FontConfig x -> FontConfig
Generic, Int -> FontConfig -> ShowS
[FontConfig] -> ShowS
FontConfig -> [Char]
(Int -> FontConfig -> ShowS)
-> (FontConfig -> [Char])
-> ([FontConfig] -> ShowS)
-> Show FontConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontConfig -> ShowS
showsPrec :: Int -> FontConfig -> ShowS
$cshow :: FontConfig -> [Char]
show :: FontConfig -> [Char]
$cshowList :: [FontConfig] -> ShowS
showList :: [FontConfig] -> ShowS
Show, [FontConfig] -> Value
[FontConfig] -> Encoding
FontConfig -> Value
FontConfig -> Encoding
(FontConfig -> Value)
-> (FontConfig -> Encoding)
-> ([FontConfig] -> Value)
-> ([FontConfig] -> Encoding)
-> ToJSON FontConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: FontConfig -> Value
toJSON :: FontConfig -> Value
$ctoEncoding :: FontConfig -> Encoding
toEncoding :: FontConfig -> Encoding
$ctoJSONList :: [FontConfig] -> Value
toJSONList :: [FontConfig] -> Value
$ctoEncodingList :: [FontConfig] -> Encoding
toEncodingList :: [FontConfig] -> Encoding
ToJSON)

-- | The default 'FontConfig' to use if not specified.
--
-- >>> defaultFontConfig == FontConfig {fontFamily = "Monospace", fontSize = defaultFontSize}
-- True
defaultFontConfig :: FontConfig
defaultFontConfig :: FontConfig
defaultFontConfig =
  FontConfig
    { fontFamily :: Text
fontFamily = Text
"Monospace"
    , fontSize :: FontSize
fontSize = FontSize
defaultFontSize
    }

fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig)
fontConfigFromFontDescription :: FontDescription -> IO (Maybe FontConfig)
fontConfigFromFontDescription FontDescription
fontDescription = do
  FontSize
fontSize <- FontDescription -> IO FontSize
fontSizeFromFontDescription FontDescription
fontDescription
  Maybe Text
maybeFontFamily <- FontDescription -> IO (Maybe Text)
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
FontDescription -> m (Maybe Text)
fontDescriptionGetFamily FontDescription
fontDescription
  Maybe FontConfig -> IO (Maybe FontConfig)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe FontConfig -> IO (Maybe FontConfig))
-> Maybe FontConfig -> IO (Maybe FontConfig)
forall a b. (a -> b) -> a -> b
$ (Text -> FontSize -> FontConfig
`FontConfig` FontSize
fontSize) (Text -> FontConfig) -> Maybe Text -> Maybe FontConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
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 (Int -> Option a -> ShowS
[Option a] -> ShowS
Option a -> [Char]
(Int -> Option a -> ShowS)
-> (Option a -> [Char]) -> ([Option a] -> ShowS) -> Show (Option a)
forall a. Show a => Int -> Option a -> ShowS
forall a. Show a => [Option a] -> ShowS
forall a. Show a => Option a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Option a -> ShowS
showsPrec :: Int -> Option a -> ShowS
$cshow :: forall a. Show a => Option a -> [Char]
show :: Option a -> [Char]
$cshowList :: forall a. Show a => [Option a] -> ShowS
showList :: [Option a] -> ShowS
Show, ReadPrec [Option a]
ReadPrec (Option a)
Int -> ReadS (Option a)
ReadS [Option a]
(Int -> ReadS (Option a))
-> ReadS [Option a]
-> ReadPrec (Option a)
-> ReadPrec [Option a]
-> Read (Option a)
forall a. Read a => ReadPrec [Option a]
forall a. Read a => ReadPrec (Option a)
forall a. Read a => Int -> ReadS (Option a)
forall a. Read a => ReadS [Option a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Option a)
readsPrec :: Int -> ReadS (Option a)
$creadList :: forall a. Read a => ReadS [Option a]
readList :: ReadS [Option a]
$creadPrec :: forall a. Read a => ReadPrec (Option a)
readPrec :: ReadPrec (Option a)
$creadListPrec :: forall a. Read a => ReadPrec [Option a]
readListPrec :: ReadPrec [Option a]
Read, Option a -> Option a -> Bool
(Option a -> Option a -> Bool)
-> (Option a -> Option a -> Bool) -> Eq (Option a)
forall a. Eq a => Option a -> Option a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Option a -> Option a -> Bool
== :: Option a -> Option a -> Bool
$c/= :: forall a. Eq a => Option a -> Option a -> Bool
/= :: Option a -> Option a -> Bool
Eq, Eq (Option a)
Eq (Option a)
-> (Option a -> Option a -> Ordering)
-> (Option a -> Option a -> Bool)
-> (Option a -> Option a -> Bool)
-> (Option a -> Option a -> Bool)
-> (Option a -> Option a -> Bool)
-> (Option a -> Option a -> Option a)
-> (Option a -> Option a -> Option a)
-> Ord (Option a)
Option a -> Option a -> Bool
Option a -> Option a -> Ordering
Option a -> Option a -> Option a
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
forall {a}. Ord a => Eq (Option a)
forall a. Ord a => Option a -> Option a -> Bool
forall a. Ord a => Option a -> Option a -> Ordering
forall a. Ord a => Option a -> Option a -> Option a
$ccompare :: forall a. Ord a => Option a -> Option a -> Ordering
compare :: Option a -> Option a -> Ordering
$c< :: forall a. Ord a => Option a -> Option a -> Bool
< :: Option a -> Option a -> Bool
$c<= :: forall a. Ord a => Option a -> Option a -> Bool
<= :: Option a -> Option a -> Bool
$c> :: forall a. Ord a => Option a -> Option a -> Bool
> :: Option a -> Option a -> Bool
$c>= :: forall a. Ord a => Option a -> Option a -> Bool
>= :: Option a -> Option a -> Bool
$cmax :: forall a. Ord a => Option a -> Option a -> Option a
max :: Option a -> Option a -> Option a
$cmin :: forall a. Ord a => Option a -> Option a -> Option a
min :: Option a -> Option a -> Option a
Ord, (forall a b. (a -> b) -> Option a -> Option b)
-> (forall a b. a -> Option b -> Option a) -> Functor Option
forall a b. a -> Option b -> Option a
forall a b. (a -> b) -> Option a -> Option b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Option a -> Option b
fmap :: forall a b. (a -> b) -> Option a -> Option b
$c<$ :: forall a b. a -> Option b -> Option a
<$ :: forall a b. a -> Option b -> Option a
Functor, (forall m. Monoid m => Option m -> m)
-> (forall m a. Monoid m => (a -> m) -> Option a -> m)
-> (forall m a. Monoid m => (a -> m) -> Option a -> m)
-> (forall a b. (a -> b -> b) -> b -> Option a -> b)
-> (forall a b. (a -> b -> b) -> b -> Option a -> b)
-> (forall b a. (b -> a -> b) -> b -> Option a -> b)
-> (forall b a. (b -> a -> b) -> b -> Option a -> b)
-> (forall a. (a -> a -> a) -> Option a -> a)
-> (forall a. (a -> a -> a) -> Option a -> a)
-> (forall a. Option a -> [a])
-> (forall a. Option a -> Bool)
-> (forall a. Option a -> Int)
-> (forall a. Eq a => a -> Option a -> Bool)
-> (forall a. Ord a => Option a -> a)
-> (forall a. Ord a => Option a -> a)
-> (forall a. Num a => Option a -> a)
-> (forall a. Num a => Option a -> a)
-> Foldable Option
forall a. Eq a => a -> Option a -> Bool
forall a. Num a => Option a -> a
forall a. Ord a => Option a -> a
forall m. Monoid m => Option m -> m
forall a. Option a -> Bool
forall a. Option a -> Int
forall a. Option a -> [a]
forall a. (a -> a -> a) -> Option a -> a
forall m a. Monoid m => (a -> m) -> Option a -> m
forall b a. (b -> a -> b) -> b -> Option a -> b
forall a b. (a -> b -> b) -> b -> Option a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Option m -> m
fold :: forall m. Monoid m => Option m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Option a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Option a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Option a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Option a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Option a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Option a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Option a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Option a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Option a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Option a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Option a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Option a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Option a -> a
foldr1 :: forall a. (a -> a -> a) -> Option a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Option a -> a
foldl1 :: forall a. (a -> a -> a) -> Option a -> a
$ctoList :: forall a. Option a -> [a]
toList :: forall a. Option a -> [a]
$cnull :: forall a. Option a -> Bool
null :: forall a. Option a -> Bool
$clength :: forall a. Option a -> Int
length :: forall a. Option a -> Int
$celem :: forall a. Eq a => a -> Option a -> Bool
elem :: forall a. Eq a => a -> Option a -> Bool
$cmaximum :: forall a. Ord a => Option a -> a
maximum :: forall a. Ord a => Option a -> a
$cminimum :: forall a. Ord a => Option a -> a
minimum :: forall a. Ord a => Option a -> a
$csum :: forall a. Num a => Option a -> a
sum :: forall a. Num a => Option a -> a
$cproduct :: forall a. Num a => Option a -> a
product :: forall a. Num a => Option a -> a
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 :: forall m a. Monoid m => Option a -> (a -> m) -> m
whenSet = \case
  Option a
Unset -> m -> (a -> m) -> m
forall a b. a -> b -> a
const m
forall a. Monoid a => a
mempty
  Set a
x -> \a -> m
f -> a -> m
f a
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 (Int -> ShowScrollbar
ShowScrollbar -> Int
ShowScrollbar -> [ShowScrollbar]
ShowScrollbar -> ShowScrollbar
ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
ShowScrollbar -> ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
(ShowScrollbar -> ShowScrollbar)
-> (ShowScrollbar -> ShowScrollbar)
-> (Int -> ShowScrollbar)
-> (ShowScrollbar -> Int)
-> (ShowScrollbar -> [ShowScrollbar])
-> (ShowScrollbar -> ShowScrollbar -> [ShowScrollbar])
-> (ShowScrollbar -> ShowScrollbar -> [ShowScrollbar])
-> (ShowScrollbar
    -> ShowScrollbar -> ShowScrollbar -> [ShowScrollbar])
-> Enum ShowScrollbar
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ShowScrollbar -> ShowScrollbar
succ :: ShowScrollbar -> ShowScrollbar
$cpred :: ShowScrollbar -> ShowScrollbar
pred :: ShowScrollbar -> ShowScrollbar
$ctoEnum :: Int -> ShowScrollbar
toEnum :: Int -> ShowScrollbar
$cfromEnum :: ShowScrollbar -> Int
fromEnum :: ShowScrollbar -> Int
$cenumFrom :: ShowScrollbar -> [ShowScrollbar]
enumFrom :: ShowScrollbar -> [ShowScrollbar]
$cenumFromThen :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
enumFromThen :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
$cenumFromTo :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
enumFromTo :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
$cenumFromThenTo :: ShowScrollbar -> ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
enumFromThenTo :: ShowScrollbar -> ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
Enum, ShowScrollbar -> ShowScrollbar -> Bool
(ShowScrollbar -> ShowScrollbar -> Bool)
-> (ShowScrollbar -> ShowScrollbar -> Bool) -> Eq ShowScrollbar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowScrollbar -> ShowScrollbar -> Bool
== :: ShowScrollbar -> ShowScrollbar -> Bool
$c/= :: ShowScrollbar -> ShowScrollbar -> Bool
/= :: ShowScrollbar -> ShowScrollbar -> Bool
Eq, (forall x. ShowScrollbar -> Rep ShowScrollbar x)
-> (forall x. Rep ShowScrollbar x -> ShowScrollbar)
-> Generic ShowScrollbar
forall x. Rep ShowScrollbar x -> ShowScrollbar
forall x. ShowScrollbar -> Rep ShowScrollbar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShowScrollbar -> Rep ShowScrollbar x
from :: forall x. ShowScrollbar -> Rep ShowScrollbar x
$cto :: forall x. Rep ShowScrollbar x -> ShowScrollbar
to :: forall x. Rep ShowScrollbar x -> ShowScrollbar
Generic, Value -> Parser [ShowScrollbar]
Value -> Parser ShowScrollbar
(Value -> Parser ShowScrollbar)
-> (Value -> Parser [ShowScrollbar]) -> FromJSON ShowScrollbar
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ShowScrollbar
parseJSON :: Value -> Parser ShowScrollbar
$cparseJSONList :: Value -> Parser [ShowScrollbar]
parseJSONList :: Value -> Parser [ShowScrollbar]
FromJSON, Int -> ShowScrollbar -> ShowS
[ShowScrollbar] -> ShowS
ShowScrollbar -> [Char]
(Int -> ShowScrollbar -> ShowS)
-> (ShowScrollbar -> [Char])
-> ([ShowScrollbar] -> ShowS)
-> Show ShowScrollbar
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowScrollbar -> ShowS
showsPrec :: Int -> ShowScrollbar -> ShowS
$cshow :: ShowScrollbar -> [Char]
show :: ShowScrollbar -> [Char]
$cshowList :: [ShowScrollbar] -> ShowS
showList :: [ShowScrollbar] -> ShowS
Show, [ShowScrollbar] -> Value
[ShowScrollbar] -> Encoding
ShowScrollbar -> Value
ShowScrollbar -> Encoding
(ShowScrollbar -> Value)
-> (ShowScrollbar -> Encoding)
-> ([ShowScrollbar] -> Value)
-> ([ShowScrollbar] -> Encoding)
-> ToJSON ShowScrollbar
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ShowScrollbar -> Value
toJSON :: ShowScrollbar -> Value
$ctoEncoding :: ShowScrollbar -> Encoding
toEncoding :: ShowScrollbar -> Encoding
$ctoJSONList :: [ShowScrollbar] -> Value
toJSONList :: [ShowScrollbar] -> Value
$ctoEncodingList :: [ShowScrollbar] -> Encoding
toEncodingList :: [ShowScrollbar] -> Encoding
ToJSON)

showScrollbarToString :: ShowScrollbar -> Text
showScrollbarToString :: ShowScrollbar -> Text
showScrollbarToString = \case
  ShowScrollbar
ShowScrollbarNever -> Text
"never"
  ShowScrollbar
ShowScrollbarAlways -> Text
"always"
  ShowScrollbar
ShowScrollbarIfNeeded -> Text
"if-needed"

showScrollbarFromString :: Text -> Maybe ShowScrollbar
showScrollbarFromString :: Text -> Maybe ShowScrollbar
showScrollbarFromString = \case
  Text
"never" -> ShowScrollbar -> Maybe ShowScrollbar
forall a. a -> Maybe a
Just ShowScrollbar
ShowScrollbarNever
  Text
"always" -> ShowScrollbar -> Maybe ShowScrollbar
forall a. a -> Maybe a
Just ShowScrollbar
ShowScrollbarAlways
  Text
"if-needed" -> ShowScrollbar -> Maybe ShowScrollbar
forall a. a -> Maybe a
Just ShowScrollbar
ShowScrollbarIfNeeded
  Text
_ -> Maybe ShowScrollbar
forall a. Maybe a
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 (Int -> ShowTabBar
ShowTabBar -> Int
ShowTabBar -> [ShowTabBar]
ShowTabBar -> ShowTabBar
ShowTabBar -> ShowTabBar -> [ShowTabBar]
ShowTabBar -> ShowTabBar -> ShowTabBar -> [ShowTabBar]
(ShowTabBar -> ShowTabBar)
-> (ShowTabBar -> ShowTabBar)
-> (Int -> ShowTabBar)
-> (ShowTabBar -> Int)
-> (ShowTabBar -> [ShowTabBar])
-> (ShowTabBar -> ShowTabBar -> [ShowTabBar])
-> (ShowTabBar -> ShowTabBar -> [ShowTabBar])
-> (ShowTabBar -> ShowTabBar -> ShowTabBar -> [ShowTabBar])
-> Enum ShowTabBar
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ShowTabBar -> ShowTabBar
succ :: ShowTabBar -> ShowTabBar
$cpred :: ShowTabBar -> ShowTabBar
pred :: ShowTabBar -> ShowTabBar
$ctoEnum :: Int -> ShowTabBar
toEnum :: Int -> ShowTabBar
$cfromEnum :: ShowTabBar -> Int
fromEnum :: ShowTabBar -> Int
$cenumFrom :: ShowTabBar -> [ShowTabBar]
enumFrom :: ShowTabBar -> [ShowTabBar]
$cenumFromThen :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
enumFromThen :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
$cenumFromTo :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
enumFromTo :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
$cenumFromThenTo :: ShowTabBar -> ShowTabBar -> ShowTabBar -> [ShowTabBar]
enumFromThenTo :: ShowTabBar -> ShowTabBar -> ShowTabBar -> [ShowTabBar]
Enum, ShowTabBar -> ShowTabBar -> Bool
(ShowTabBar -> ShowTabBar -> Bool)
-> (ShowTabBar -> ShowTabBar -> Bool) -> Eq ShowTabBar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ShowTabBar -> ShowTabBar -> Bool
== :: ShowTabBar -> ShowTabBar -> Bool
$c/= :: ShowTabBar -> ShowTabBar -> Bool
/= :: ShowTabBar -> ShowTabBar -> Bool
Eq, (forall x. ShowTabBar -> Rep ShowTabBar x)
-> (forall x. Rep ShowTabBar x -> ShowTabBar) -> Generic ShowTabBar
forall x. Rep ShowTabBar x -> ShowTabBar
forall x. ShowTabBar -> Rep ShowTabBar x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ShowTabBar -> Rep ShowTabBar x
from :: forall x. ShowTabBar -> Rep ShowTabBar x
$cto :: forall x. Rep ShowTabBar x -> ShowTabBar
to :: forall x. Rep ShowTabBar x -> ShowTabBar
Generic, Value -> Parser [ShowTabBar]
Value -> Parser ShowTabBar
(Value -> Parser ShowTabBar)
-> (Value -> Parser [ShowTabBar]) -> FromJSON ShowTabBar
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ShowTabBar
parseJSON :: Value -> Parser ShowTabBar
$cparseJSONList :: Value -> Parser [ShowTabBar]
parseJSONList :: Value -> Parser [ShowTabBar]
FromJSON, Int -> ShowTabBar -> ShowS
[ShowTabBar] -> ShowS
ShowTabBar -> [Char]
(Int -> ShowTabBar -> ShowS)
-> (ShowTabBar -> [Char])
-> ([ShowTabBar] -> ShowS)
-> Show ShowTabBar
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ShowTabBar -> ShowS
showsPrec :: Int -> ShowTabBar -> ShowS
$cshow :: ShowTabBar -> [Char]
show :: ShowTabBar -> [Char]
$cshowList :: [ShowTabBar] -> ShowS
showList :: [ShowTabBar] -> ShowS
Show, [ShowTabBar] -> Value
[ShowTabBar] -> Encoding
ShowTabBar -> Value
ShowTabBar -> Encoding
(ShowTabBar -> Value)
-> (ShowTabBar -> Encoding)
-> ([ShowTabBar] -> Value)
-> ([ShowTabBar] -> Encoding)
-> ToJSON ShowTabBar
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ShowTabBar -> Value
toJSON :: ShowTabBar -> Value
$ctoEncoding :: ShowTabBar -> Encoding
toEncoding :: ShowTabBar -> Encoding
$ctoJSONList :: [ShowTabBar] -> Value
toJSONList :: [ShowTabBar] -> Value
$ctoEncodingList :: [ShowTabBar] -> Encoding
toEncodingList :: [ShowTabBar] -> Encoding
ToJSON)

showTabBarToString :: ShowTabBar -> Text
showTabBarToString :: ShowTabBar -> Text
showTabBarToString = \case
  ShowTabBar
ShowTabBarNever -> Text
"never"
  ShowTabBar
ShowTabBarAlways -> Text
"always"
  ShowTabBar
ShowTabBarIfNeeded -> Text
"if-needed"

showTabBarFromString :: Text -> Maybe ShowTabBar
showTabBarFromString :: Text -> Maybe ShowTabBar
showTabBarFromString = \case
  Text
"never" -> ShowTabBar -> Maybe ShowTabBar
forall a. a -> Maybe a
Just ShowTabBar
ShowTabBarNever
  Text
"always" -> ShowTabBar -> Maybe ShowTabBar
forall a. a -> Maybe a
Just ShowTabBar
ShowTabBarAlways
  Text
"if-needed" -> ShowTabBar -> Maybe ShowTabBar
forall a. a -> Maybe a
Just ShowTabBar
ShowTabBarIfNeeded
  Text
_ -> Maybe ShowTabBar
forall a. Maybe a
Nothing

-- | Configuration options for Termonad.
--
-- See 'defaultConfigOptions' for the default values.
data ConfigOptions = ConfigOptions
  { ConfigOptions -> FontConfig
fontConfig :: !FontConfig
    -- ^ Specific options for fonts.
  , ConfigOptions -> ShowScrollbar
showScrollbar :: !ShowScrollbar
    -- ^ When to show the scroll bar.
  , ConfigOptions -> Integer
scrollbackLen :: !Integer
    -- ^ The number of lines to keep in the scroll back history for each terminal.
  , ConfigOptions -> Bool
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'.
  , ConfigOptions -> Text
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.
  , ConfigOptions -> Bool
showMenu :: !Bool
    -- ^ Whether or not to show the @File@ @Edit@ etc menu.
  , ConfigOptions -> ShowTabBar
showTabBar :: !ShowTabBar
    -- ^ When to show the tab bar.
  , ConfigOptions -> CursorBlinkMode
cursorBlinkMode :: !CursorBlinkMode
    -- ^ How to handle cursor blink.
  , ConfigOptions -> Bool
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'.
  , ConfigOptions -> Bool
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.
  , ConfigOptions -> Bool
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 (ConfigOptions -> ConfigOptions -> Bool
(ConfigOptions -> ConfigOptions -> Bool)
-> (ConfigOptions -> ConfigOptions -> Bool) -> Eq ConfigOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigOptions -> ConfigOptions -> Bool
== :: ConfigOptions -> ConfigOptions -> Bool
$c/= :: ConfigOptions -> ConfigOptions -> Bool
/= :: ConfigOptions -> ConfigOptions -> Bool
Eq, (forall x. ConfigOptions -> Rep ConfigOptions x)
-> (forall x. Rep ConfigOptions x -> ConfigOptions)
-> Generic ConfigOptions
forall x. Rep ConfigOptions x -> ConfigOptions
forall x. ConfigOptions -> Rep ConfigOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ConfigOptions -> Rep ConfigOptions x
from :: forall x. ConfigOptions -> Rep ConfigOptions x
$cto :: forall x. Rep ConfigOptions x -> ConfigOptions
to :: forall x. Rep ConfigOptions x -> ConfigOptions
Generic, Value -> Parser [ConfigOptions]
Value -> Parser ConfigOptions
(Value -> Parser ConfigOptions)
-> (Value -> Parser [ConfigOptions]) -> FromJSON ConfigOptions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ConfigOptions
parseJSON :: Value -> Parser ConfigOptions
$cparseJSONList :: Value -> Parser [ConfigOptions]
parseJSONList :: Value -> Parser [ConfigOptions]
FromJSON, Int -> ConfigOptions -> ShowS
[ConfigOptions] -> ShowS
ConfigOptions -> [Char]
(Int -> ConfigOptions -> ShowS)
-> (ConfigOptions -> [Char])
-> ([ConfigOptions] -> ShowS)
-> Show ConfigOptions
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConfigOptions -> ShowS
showsPrec :: Int -> ConfigOptions -> ShowS
$cshow :: ConfigOptions -> [Char]
show :: ConfigOptions -> [Char]
$cshowList :: [ConfigOptions] -> ShowS
showList :: [ConfigOptions] -> ShowS
Show, [ConfigOptions] -> Value
[ConfigOptions] -> Encoding
ConfigOptions -> Value
ConfigOptions -> Encoding
(ConfigOptions -> Value)
-> (ConfigOptions -> Encoding)
-> ([ConfigOptions] -> Value)
-> ([ConfigOptions] -> Encoding)
-> ToJSON ConfigOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ConfigOptions -> Value
toJSON :: ConfigOptions -> Value
$ctoEncoding :: ConfigOptions -> Encoding
toEncoding :: ConfigOptions -> Encoding
$ctoJSONList :: [ConfigOptions] -> Value
toJSONList :: [ConfigOptions] -> Value
$ctoEncodingList :: [ConfigOptions] -> Encoding
toEncodingList :: [ConfigOptions] -> Encoding
ToJSON)

cursorBlinkModeToString :: CursorBlinkMode -> Text
cursorBlinkModeToString :: CursorBlinkMode -> Text
cursorBlinkModeToString = \case
  CursorBlinkMode
CursorBlinkModeSystem -> Text
"system"
  CursorBlinkMode
CursorBlinkModeOn -> Text
"on"
  CursorBlinkMode
CursorBlinkModeOff -> Text
"off"
  AnotherCursorBlinkMode Int
_ -> Text
"other"

cursorBlinkModeFromString :: Text -> Maybe CursorBlinkMode
cursorBlinkModeFromString :: Text -> Maybe CursorBlinkMode
cursorBlinkModeFromString = \case
  Text
"system" -> CursorBlinkMode -> Maybe CursorBlinkMode
forall a. a -> Maybe a
Just CursorBlinkMode
CursorBlinkModeSystem
  Text
"on" -> CursorBlinkMode -> Maybe CursorBlinkMode
forall a. a -> Maybe a
Just CursorBlinkMode
CursorBlinkModeOn
  Text
"off" -> CursorBlinkMode -> Maybe CursorBlinkMode
forall a. a -> Maybe a
Just CursorBlinkMode
CursorBlinkModeOff
  Text
_ -> Maybe CursorBlinkMode
forall a. Maybe a
Nothing

instance FromJSON CursorBlinkMode where
  parseJSON :: Value -> Parser CursorBlinkMode
parseJSON = [Char]
-> (Text -> Parser CursorBlinkMode)
-> Value
-> Parser CursorBlinkMode
forall a. [Char] -> (Text -> Parser a) -> Value -> Parser a
withText [Char]
"CursorBlinkMode" ((Text -> Parser CursorBlinkMode)
 -> Value -> Parser CursorBlinkMode)
-> (Text -> Parser CursorBlinkMode)
-> Value
-> Parser CursorBlinkMode
forall a b. (a -> b) -> a -> b
$ \Text
c -> do
    case (Text
c :: Text) of
      Text
"CursorBlinkModeSystem" -> CursorBlinkMode -> Parser CursorBlinkMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeSystem
      Text
"CursorBlinkModeOn" -> CursorBlinkMode -> Parser CursorBlinkMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeOn
      Text
"CursorBlinkModeOff" -> CursorBlinkMode -> Parser CursorBlinkMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeOff
      Text
_ -> [Char] -> Parser CursorBlinkMode
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Wrong value for CursorBlinkMode"

instance ToJSON CursorBlinkMode where
  toJSON :: CursorBlinkMode -> Value
toJSON CursorBlinkMode
CursorBlinkModeSystem = Text -> Value
String Text
"CursorBlinkModeSystem"
  toJSON CursorBlinkMode
CursorBlinkModeOn = Text -> Value
String Text
"CursorBlinkModeOn"
  toJSON CursorBlinkMode
CursorBlinkModeOff = Text -> Value
String Text
"CursorBlinkModeOff"
  -- Not supposed to happened fall back to system
  toJSON (AnotherCursorBlinkMode Int
_) = Text -> Value
String Text
"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
defaultConfigOptions =
  ConfigOptions
    { fontConfig :: FontConfig
fontConfig = FontConfig
defaultFontConfig
    , showScrollbar :: ShowScrollbar
showScrollbar = ShowScrollbar
ShowScrollbarIfNeeded
    , scrollbackLen :: Integer
scrollbackLen = Integer
10000
    , confirmExit :: Bool
confirmExit = Bool
True
    , wordCharExceptions :: Text
wordCharExceptions = Text
"-#%&+,./=?@\\_~\183:"
    , showMenu :: Bool
showMenu = Bool
True
    , showTabBar :: ShowTabBar
showTabBar = ShowTabBar
ShowTabBarIfNeeded
    , cursorBlinkMode :: CursorBlinkMode
cursorBlinkMode = CursorBlinkMode
CursorBlinkModeOn
    , boldIsBright :: Bool
boldIsBright = Bool
False
    , enableSixel :: Bool
enableSixel = Bool
False
    , allowBold :: Bool
allowBold = Bool
True
    }

-- | The Termonad 'ConfigOptions' along with the 'ConfigHooks'.
data TMConfig = TMConfig
  { TMConfig -> ConfigOptions
options :: !ConfigOptions
  , TMConfig -> ConfigHooks
hooks :: !ConfigHooks
  } deriving Int -> TMConfig -> ShowS
[TMConfig] -> ShowS
TMConfig -> [Char]
(Int -> TMConfig -> ShowS)
-> (TMConfig -> [Char]) -> ([TMConfig] -> ShowS) -> Show TMConfig
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TMConfig -> ShowS
showsPrec :: Int -> TMConfig -> ShowS
$cshow :: TMConfig -> [Char]
show :: TMConfig -> [Char]
$cshowList :: [TMConfig] -> ShowS
showList :: [TMConfig] -> ShowS
Show

-- | The default 'TMConfig'.
--
-- 'options' is 'defaultConfigOptions' and 'hooks' is 'defaultConfigHooks'.
defaultTMConfig :: TMConfig
defaultTMConfig :: TMConfig
defaultTMConfig =
  TMConfig
    { options :: ConfigOptions
options = ConfigOptions
defaultConfigOptions
    , hooks :: ConfigHooks
hooks = ConfigHooks
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.
  ConfigHooks -> TMState -> Terminal -> IO ()
createTermHook :: TMState -> Terminal -> IO ()
}

instance Show ConfigHooks where
  showsPrec :: Int -> ConfigHooks -> ShowS
  showsPrec :: Int -> ConfigHooks -> ShowS
showsPrec Int
_ ConfigHooks
_ =
    [Char] -> ShowS
showString [Char]
"ConfigHooks {" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [Char] -> ShowS
showString [Char]
"createTermHook = <function>" ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    [Char] -> ShowS
showString [Char]
"}"

-- | Default values for the 'ConfigHooks'.
--
-- - The default function for 'createTermHook' is 'defaultCreateTermHook'.
defaultConfigHooks :: ConfigHooks
defaultConfigHooks :: ConfigHooks
defaultConfigHooks =
  ConfigHooks
    { createTermHook :: TMState -> Terminal -> IO ()
createTermHook = TMState -> Terminal -> IO ()
defaultCreateTermHook
    }

-- | Default value for 'createTermHook'.  Does nothing.
defaultCreateTermHook :: TMState -> Terminal -> IO ()
defaultCreateTermHook :: TMState -> Terminal -> IO ()
defaultCreateTermHook TMState
_ Terminal
_ = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

----------------
-- Invariants --
----------------

data FocusNotSameErr
  = FocusListFocusExistsButNoNotebookTabWidget
  | NotebookTabWidgetDiffersFromFocusListFocus
  | NotebookTabWidgetExistsButNoFocusListFocus
  deriving Int -> FocusNotSameErr -> ShowS
[FocusNotSameErr] -> ShowS
FocusNotSameErr -> [Char]
(Int -> FocusNotSameErr -> ShowS)
-> (FocusNotSameErr -> [Char])
-> ([FocusNotSameErr] -> ShowS)
-> Show FocusNotSameErr
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FocusNotSameErr -> ShowS
showsPrec :: Int -> FocusNotSameErr -> ShowS
$cshow :: FocusNotSameErr -> [Char]
show :: FocusNotSameErr -> [Char]
$cshowList :: [FocusNotSameErr] -> ShowS
showList :: [FocusNotSameErr] -> ShowS
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 (Int -> TabsDoNotMatch -> ShowS
[TabsDoNotMatch] -> ShowS
TabsDoNotMatch -> [Char]
(Int -> TabsDoNotMatch -> ShowS)
-> (TabsDoNotMatch -> [Char])
-> ([TabsDoNotMatch] -> ShowS)
-> Show TabsDoNotMatch
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TabsDoNotMatch -> ShowS
showsPrec :: Int -> TabsDoNotMatch -> ShowS
$cshow :: TabsDoNotMatch -> [Char]
show :: TabsDoNotMatch -> [Char]
$cshowList :: [TabsDoNotMatch] -> ShowS
showList :: [TabsDoNotMatch] -> ShowS
Show)

-- | An invariant error on a given 'TMWindow'.
data TMWinInvariantErr
  = FocusNotSame FocusNotSameErr Int
  | TabsDoNotMatch TabsDoNotMatch
  deriving Int -> TMWinInvariantErr -> ShowS
[TMWinInvariantErr] -> ShowS
TMWinInvariantErr -> [Char]
(Int -> TMWinInvariantErr -> ShowS)
-> (TMWinInvariantErr -> [Char])
-> ([TMWinInvariantErr] -> ShowS)
-> Show TMWinInvariantErr
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TMWinInvariantErr -> ShowS
showsPrec :: Int -> TMWinInvariantErr -> ShowS
$cshow :: TMWinInvariantErr -> [Char]
show :: TMWinInvariantErr -> [Char]
$cshowList :: [TMWinInvariantErr] -> ShowS
showList :: [TMWinInvariantErr] -> ShowS
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 Int -> TMStateInvariantErr -> ShowS
[TMStateInvariantErr] -> ShowS
TMStateInvariantErr -> [Char]
(Int -> TMStateInvariantErr -> ShowS)
-> (TMStateInvariantErr -> [Char])
-> ([TMStateInvariantErr] -> ShowS)
-> Show TMStateInvariantErr
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TMStateInvariantErr -> ShowS
showsPrec :: Int -> TMStateInvariantErr -> ShowS
$cshow :: TMStateInvariantErr -> [Char]
show :: TMStateInvariantErr -> [Char]
$cshowList :: [TMStateInvariantErr] -> ShowS
showList :: [TMStateInvariantErr] -> ShowS
Show

invariantTMWindow :: TMWindow -> IO [TMWinInvariantErr]
invariantTMWindow :: TMWindow -> IO [TMWinInvariantErr]
invariantTMWindow TMWindow
tmWin =
  [IO (Maybe TMWinInvariantErr)] -> IO [TMWinInvariantErr]
runInvariants
    [ IO (Maybe TMWinInvariantErr)
Item [IO (Maybe TMWinInvariantErr)]
invariantFocusSame
    , IO (Maybe TMWinInvariantErr)
Item [IO (Maybe TMWinInvariantErr)]
invariantTMTabLength
    , IO (Maybe TMWinInvariantErr)
Item [IO (Maybe TMWinInvariantErr)]
invariantTabsAllMatch
    ]
  where
    runInvariants :: [IO (Maybe TMWinInvariantErr)] -> IO [TMWinInvariantErr]
    runInvariants :: [IO (Maybe TMWinInvariantErr)] -> IO [TMWinInvariantErr]
runInvariants = ([Maybe TMWinInvariantErr] -> [TMWinInvariantErr])
-> IO [Maybe TMWinInvariantErr] -> IO [TMWinInvariantErr]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe TMWinInvariantErr] -> [TMWinInvariantErr]
forall a. [Maybe a] -> [a]
catMaybes (IO [Maybe TMWinInvariantErr] -> IO [TMWinInvariantErr])
-> ([IO (Maybe TMWinInvariantErr)] -> IO [Maybe TMWinInvariantErr])
-> [IO (Maybe TMWinInvariantErr)]
-> IO [TMWinInvariantErr]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [IO (Maybe TMWinInvariantErr)] -> IO [Maybe TMWinInvariantErr]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence

    invariantFocusSame :: IO (Maybe TMWinInvariantErr)
    invariantFocusSame :: IO (Maybe TMWinInvariantErr)
invariantFocusSame = do
      let tmNote :: Notebook
tmNote = TMNotebook -> Notebook
tmNotebook (TMNotebook -> Notebook) -> TMNotebook -> Notebook
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin
      Int32
index32 <- Notebook -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> m Int32
notebookGetCurrentPage Notebook
tmNote
      Maybe Widget
maybeWidgetFromNote <- Notebook -> Int32 -> IO (Maybe Widget)
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> Int32 -> m (Maybe Widget)
notebookGetNthPage Notebook
tmNote Int32
index32
      let focusList :: FocusList TMNotebookTab
focusList = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs (TMNotebook -> FocusList TMNotebookTab)
-> TMNotebook -> FocusList TMNotebookTab
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin
          maybeScrollWinFromFL :: Maybe ScrolledWindow
maybeScrollWinFromFL =
            TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer (TMNotebookTab -> ScrolledWindow)
-> Maybe TMNotebookTab -> Maybe ScrolledWindow
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FocusList TMNotebookTab -> Maybe TMNotebookTab
forall a. FocusList a -> Maybe a
getFocusItemFL FocusList TMNotebookTab
focusList
          idx :: Int
idx = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
index32
      case (Maybe Widget
maybeWidgetFromNote, Maybe ScrolledWindow
maybeScrollWinFromFL) of
        (Maybe Widget
Nothing, Maybe ScrolledWindow
Nothing) -> Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMWinInvariantErr
forall a. Maybe a
Nothing
        (Just Widget
_, Maybe ScrolledWindow
Nothing) ->
          Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr))
-> Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a b. (a -> b) -> a -> b
$
            TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a. a -> Maybe a
Just (TMWinInvariantErr -> Maybe TMWinInvariantErr)
-> TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a b. (a -> b) -> a -> b
$
              FocusNotSameErr -> Int -> TMWinInvariantErr
FocusNotSame FocusNotSameErr
NotebookTabWidgetExistsButNoFocusListFocus Int
idx
        (Maybe Widget
Nothing, Just ScrolledWindow
_) ->
          Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr))
-> Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a b. (a -> b) -> a -> b
$
            TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a. a -> Maybe a
Just (TMWinInvariantErr -> Maybe TMWinInvariantErr)
-> TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a b. (a -> b) -> a -> b
$
              FocusNotSameErr -> Int -> TMWinInvariantErr
FocusNotSame FocusNotSameErr
FocusListFocusExistsButNoNotebookTabWidget Int
idx
        (Just Widget
widgetFromNote, Just ScrolledWindow
scrollWinFromFL) -> do
          Bool
isEq <- Widget -> ScrolledWindow -> IO Bool
forall (m :: * -> *) a b.
(MonadIO m, IsWidget a, IsWidget b) =>
a -> b -> m Bool
widgetEq Widget
widgetFromNote ScrolledWindow
scrollWinFromFL
          if Bool
isEq
            then Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMWinInvariantErr
forall a. Maybe a
Nothing
            else
              Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr))
-> Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a b. (a -> b) -> a -> b
$
                TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a. a -> Maybe a
Just (TMWinInvariantErr -> Maybe TMWinInvariantErr)
-> TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a b. (a -> b) -> a -> b
$
                  FocusNotSameErr -> Int -> TMWinInvariantErr
FocusNotSame FocusNotSameErr
NotebookTabWidgetDiffersFromFocusListFocus Int
idx

    invariantTMTabLength :: IO (Maybe TMWinInvariantErr)
    invariantTMTabLength :: IO (Maybe TMWinInvariantErr)
invariantTMTabLength = do
      let tmNote :: Notebook
tmNote = TMNotebook -> Notebook
tmNotebook (TMNotebook -> Notebook) -> TMNotebook -> Notebook
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin
      Int32
noteLength32 <- Notebook -> IO Int32
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> m Int32
notebookGetNPages Notebook
tmNote
      let noteLength :: Int
noteLength = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
noteLength32
          focusListLength :: Int
focusListLength = FocusList TMNotebookTab -> Int
forall a. FocusList a -> Int
lengthFL (FocusList TMNotebookTab -> Int) -> FocusList TMNotebookTab -> Int
forall a b. (a -> b) -> a -> b
$ TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs (TMNotebook -> FocusList TMNotebookTab)
-> TMNotebook -> FocusList TMNotebookTab
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin
          lengthEqual :: Bool
lengthEqual = Int
focusListLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noteLength
      if Bool
lengthEqual
        then Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMWinInvariantErr
forall a. Maybe a
Nothing
        else  Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr))
-> Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a b. (a -> b) -> a -> b
$
               TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a. a -> Maybe a
Just (TMWinInvariantErr -> Maybe TMWinInvariantErr)
-> TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a b. (a -> b) -> a -> b
$
                TabsDoNotMatch -> TMWinInvariantErr
TabsDoNotMatch (TabsDoNotMatch -> TMWinInvariantErr)
-> TabsDoNotMatch -> TMWinInvariantErr
forall a b. (a -> b) -> a -> b
$
                 Int -> Int -> TabsDoNotMatch
TabLengthsDifferent Int
noteLength Int
focusListLength

    -- Turns a FocusList and Notebook into two lists of widgets and compares each widget for equality
    invariantTabsAllMatch :: IO (Maybe TMWinInvariantErr)
    invariantTabsAllMatch :: IO (Maybe TMWinInvariantErr)
invariantTabsAllMatch = do
      let tmNote :: Notebook
tmNote = TMNotebook -> Notebook
tmNotebook (TMNotebook -> Notebook) -> TMNotebook -> Notebook
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin
          focusList :: FocusList TMNotebookTab
focusList = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs (TMNotebook -> FocusList TMNotebookTab)
-> TMNotebook -> FocusList TMNotebookTab
forall a b. (a -> b) -> a -> b
$ TMWindow -> TMNotebook
tmWindowNotebook TMWindow
tmWin
          flList :: [ScrolledWindow]
flList = TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer (TMNotebookTab -> ScrolledWindow)
-> [TMNotebookTab] -> [ScrolledWindow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FocusList TMNotebookTab -> [TMNotebookTab]
forall a. FocusList a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList FocusList TMNotebookTab
focusList
      [Widget]
noteList <- Notebook -> IO [Widget]
notebookToList Notebook
tmNote
      [Widget] -> [ScrolledWindow] -> IO (Maybe TMWinInvariantErr)
forall a b.
(IsWidget a, IsWidget b) =>
[a] -> [b] -> IO (Maybe TMWinInvariantErr)
tabsMatch [Widget]
noteList [ScrolledWindow]
flList
      where
        tabsMatch
          :: forall a b
           . (IsWidget a, IsWidget b)
          => [a]
          -> [b]
          -> IO (Maybe TMWinInvariantErr)
        tabsMatch :: forall a b.
(IsWidget a, IsWidget b) =>
[a] -> [b] -> IO (Maybe TMWinInvariantErr)
tabsMatch [a]
xs [b]
ys = ((a, b, Int)
 -> IO (Maybe TMWinInvariantErr) -> IO (Maybe TMWinInvariantErr))
-> IO (Maybe TMWinInvariantErr)
-> [(a, b, Int)]
-> IO (Maybe TMWinInvariantErr)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (a, b, Int)
-> IO (Maybe TMWinInvariantErr) -> IO (Maybe TMWinInvariantErr)
go (Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMWinInvariantErr
forall a. Maybe a
Nothing) ([a] -> [b] -> [Int] -> [(a, b, Int)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [a]
xs [b]
ys [Int
Item [Int]
0..])
          where
            go :: (a, b, Int) -> IO (Maybe TMWinInvariantErr) -> IO (Maybe TMWinInvariantErr)
            go :: (a, b, Int)
-> IO (Maybe TMWinInvariantErr) -> IO (Maybe TMWinInvariantErr)
go (a
x, b
y, Int
i) IO (Maybe TMWinInvariantErr)
acc = do
              Bool
isEq <- a -> b -> IO Bool
forall (m :: * -> *) a b.
(MonadIO m, IsWidget a, IsWidget b) =>
a -> b -> m Bool
widgetEq a
x b
y
              if Bool
isEq
                then IO (Maybe TMWinInvariantErr)
acc
                else Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMWinInvariantErr -> IO (Maybe TMWinInvariantErr))
-> (TMWinInvariantErr -> Maybe TMWinInvariantErr)
-> TMWinInvariantErr
-> IO (Maybe TMWinInvariantErr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMWinInvariantErr -> Maybe TMWinInvariantErr
forall a. a -> Maybe a
Just (TMWinInvariantErr -> IO (Maybe TMWinInvariantErr))
-> TMWinInvariantErr -> IO (Maybe TMWinInvariantErr)
forall a b. (a -> b) -> a -> b
$ TabsDoNotMatch -> TMWinInvariantErr
TabsDoNotMatch (Int -> TabsDoNotMatch
TabAtIndexDifferent Int
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' -> IO [TMStateInvariantErr]
invariantTMState' TMState'
tmState = do
  let tmWindows :: IdMap TMWindow
tmWindows = TMState' -> IdMap TMWindow
tmStateWindows TMState'
tmState
  (Int -> TMWindow -> IO [TMStateInvariantErr])
-> IdMap TMWindow -> IO [TMStateInvariantErr]
forall m a. Monoid m => (Int -> a -> m) -> IdMap a -> m
forall i (f :: * -> *) m a.
(FoldableWithIndex i f, Monoid m) =>
(i -> a -> m) -> f a -> m
ifoldMap Int -> TMWindow -> IO [TMStateInvariantErr]
go IdMap TMWindow
tmWindows
  where
    go :: Int -> TMWindow -> IO [TMStateInvariantErr]
    go :: Int -> TMWindow -> IO [TMStateInvariantErr]
go Int
idx TMWindow
tmWin = do
      [TMWinInvariantErr]
tmWinErrs <- TMWindow -> IO [TMWinInvariantErr]
invariantTMWindow TMWindow
tmWin
      [TMStateInvariantErr] -> IO [TMStateInvariantErr]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([TMStateInvariantErr] -> IO [TMStateInvariantErr])
-> [TMStateInvariantErr] -> IO [TMStateInvariantErr]
forall a b. (a -> b) -> a -> b
$ (TMWinInvariantErr -> TMStateInvariantErr)
-> [TMWinInvariantErr] -> [TMStateInvariantErr]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> TMWinInvariantErr -> TMStateInvariantErr
TMWinInvariantErr Int
idx) [TMWinInvariantErr]
tmWinErrs

-- | Check the invariants for 'TMState', and call 'fail' if we find that they
-- have been violated.
assertInvariantTMState :: TMState -> IO ()
assertInvariantTMState :: TMState -> IO ()
assertInvariantTMState TMState
mvarTMState = do
  TMState'
tmState <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
  [TMStateInvariantErr]
assertValue <- TMState' -> IO [TMStateInvariantErr]
invariantTMState' TMState'
tmState
  case [TMStateInvariantErr]
assertValue of
    [] x-> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    errs :: [TMStateInvariantErr]
errs@(TMStateInvariantErr
_:[TMStateInvariantErr]
_) -> do
      [Char] -> IO ()
putStrLn [Char]
"In assertInvariantTMState, some invariants for TMState are being violated."
      [Char] -> IO ()
putStrLn [Char]
"\nInvariants violated:"
      [TMStateInvariantErr] -> IO ()
forall a. Show a => a -> IO ()
print [TMStateInvariantErr]
errs
      [Char] -> IO ()
putStrLn [Char]
"\nTMState:"
      TMState' -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint TMState'
tmState
      [Char] -> IO ()
putStrLn [Char]
""
      [Char] -> IO ()
forall a. [Char] -> IO a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Invariants violated for TMState"

pPrintTMState :: TMState -> IO ()
pPrintTMState :: TMState -> IO ()
pPrintTMState TMState
mvarTMState = do
  TMState'
tmState <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
  TMState' -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint TMState'
tmState

traceShowMTMState :: TMState -> IO ()
traceShowMTMState :: TMState -> IO ()
traceShowMTMState TMState
mvarTMState = do
  TMState'
tmState <- TMState -> IO TMState'
forall a. MVar a -> IO a
readMVar TMState
mvarTMState
  TMState' -> IO ()
forall a. Show a => a -> IO ()
print TMState'
tmState