{-# 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)
data TMTerm = TMTerm
{ TMTerm -> Terminal
term :: !Terminal
, TMTerm -> Int
pid :: !Int
, TMTerm -> Unique
unique :: !Unique
}
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]
"}"
data TMNotebookTab = TMNotebookTab
{ TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer :: !ScrolledWindow
, TMNotebookTab -> TMTerm
tmNotebookTabTerm :: !TMTerm
, TMNotebookTab -> Label
tmNotebookTabLabel :: !Label
}
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]
"}"
data TMNotebook = TMNotebook
{ TMNotebook -> Notebook
tmNotebook :: !Notebook
, TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs :: !(FocusList 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
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
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)
data FontSize
= FontSizePoints Int
| FontSizeUnits Double
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)
defaultFontSize :: FontSize
defaultFontSize :: FontSize
defaultFontSize = Int -> FontSize
FontSizePoints Int
12
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
createFontDesc
:: FontSize
-> Text
-> 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
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
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)
data FontConfig = FontConfig
{ FontConfig -> Text
fontFamily :: !Text
, FontConfig -> FontSize
fontSize :: !FontSize
} 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)
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
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)
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
data ShowScrollbar
= ShowScrollbarNever
| ShowScrollbarAlways
| ShowScrollbarIfNeeded
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
data ShowTabBar
= ShowTabBarNever
| ShowTabBarAlways
| ShowTabBarIfNeeded
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
data ConfigOptions = ConfigOptions
{ ConfigOptions -> FontConfig
fontConfig :: !FontConfig
, ConfigOptions -> ShowScrollbar
showScrollbar :: !ShowScrollbar
, ConfigOptions -> Integer
scrollbackLen :: !Integer
, ConfigOptions -> Bool
confirmExit :: !Bool
, ConfigOptions -> Text
wordCharExceptions :: !Text
, :: !Bool
, ConfigOptions -> ShowTabBar
showTabBar :: !ShowTabBar
, ConfigOptions -> CursorBlinkMode
cursorBlinkMode :: !CursorBlinkMode
, ConfigOptions -> Bool
boldIsBright :: !Bool
, ConfigOptions -> Bool
enableSixel :: !Bool
, ConfigOptions -> Bool
allowBold :: !Bool
} 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"
toJSON (AnotherCursorBlinkMode Int
_) = Text -> Value
String Text
"CursorBlinkModeSystem"
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
}
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
defaultTMConfig :: TMConfig
defaultTMConfig :: TMConfig
defaultTMConfig =
TMConfig
{ options :: ConfigOptions
options = ConfigOptions
defaultConfigOptions
, hooks :: ConfigHooks
hooks = ConfigHooks
defaultConfigHooks
}
newtype ConfigHooks = ConfigHooks {
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]
"}"
defaultConfigHooks :: ConfigHooks
defaultConfigHooks :: ConfigHooks
defaultConfigHooks =
ConfigHooks
{ createTermHook :: TMState -> Terminal -> IO ()
createTermHook = TMState -> Terminal -> IO ()
defaultCreateTermHook
}
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 ()
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
| TabAtIndexDifferent Int
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)
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
data TMStateInvariantErr
= TMWinInvariantErr Int TMWinInvariantErr
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
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)
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
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