{-# OPTIONS_GHC -fno-warn-orphans #-}
module Termonad.Types where
import Termonad.Prelude
import Control.Monad.Fail (fail)
import Data.FocusList (FocusList, emptyFL, singletonFL, getFocusItemFL, lengthFL)
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)
import GI.Vte (Terminal, CursorBlinkMode(..))
import Text.Pretty.Simple (pPrint)
import Text.Show (ShowS, showParen, showString)
import Termonad.Gtk (widgetEq)
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
unique :: Unique
pid :: Int
term :: Terminal
unique :: TMTerm -> Unique
pid :: TMTerm -> Int
term :: TMTerm -> Terminal
..} =
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
$
String -> ShowS
showString String
"TMTerm {" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"term = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"(GI.GTK.Terminal)" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"pid = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"unique = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"}"
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
tmNotebookTabLabel :: Label
tmNotebookTabTerm :: TMTerm
tmNotebookTabTermContainer :: ScrolledWindow
tmNotebookTabLabel :: TMNotebookTab -> Label
tmNotebookTabTerm :: TMNotebookTab -> TMTerm
tmNotebookTabTermContainer :: TMNotebookTab -> ScrolledWindow
..} =
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
$
String -> ShowS
showString String
"TMNotebookTab {" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmNotebookTabTermContainer = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"(GI.GTK.ScrolledWindow)" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmNotebookTabTerm = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmNotebookTabLabel = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"(GI.GTK.Label)" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"}"
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 :: FocusList TMNotebookTab
tmNotebook :: Notebook
tmNotebookTabs :: TMNotebook -> FocusList TMNotebookTab
tmNotebook :: TMNotebook -> Notebook
..} =
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
$
String -> ShowS
showString String
"TMNotebook {" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmNotebook = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"(GI.GTK.Notebook)" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmNotebookTabs = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"}"
data TMState' = TMState
{ TMState' -> Application
tmStateApp :: !Application
, TMState' -> ApplicationWindow
tmStateAppWin :: !ApplicationWindow
, TMState' -> TMNotebook
tmStateNotebook :: !TMNotebook
, TMState' -> FontDescription
tmStateFontDesc :: !FontDescription
, TMState' -> TMConfig
tmStateConfig :: !TMConfig
}
instance Show TMState' where
showsPrec :: Int -> TMState' -> ShowS
showsPrec :: Int -> TMState' -> ShowS
showsPrec Int
d TMState{ApplicationWindow
Application
FontDescription
TMConfig
TMNotebook
tmStateConfig :: TMConfig
tmStateFontDesc :: FontDescription
tmStateNotebook :: TMNotebook
tmStateAppWin :: ApplicationWindow
tmStateApp :: Application
tmStateConfig :: TMState' -> TMConfig
tmStateFontDesc :: TMState' -> FontDescription
tmStateNotebook :: TMState' -> TMNotebook
tmStateAppWin :: TMState' -> ApplicationWindow
tmStateApp :: TMState' -> Application
..} =
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
$
String -> ShowS
showString String
"TMState {" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmStateApp = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"(GI.GTK.Application)" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmStateAppWin = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"(GI.GTK.ApplicationWindow)" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmStateNotebook = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
tmStateNotebook ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmStateFontDesc = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"(GI.Pango.FontDescription)" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
", " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"tmStateConfig = " ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"}"
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 :: Terminal -> Int -> Unique -> TMTerm
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 -> IO (Maybe Terminal)
getFocusedTermFromState :: TMState -> IO (Maybe Terminal)
getFocusedTermFromState TMState
mvarTMState =
TMState -> (TMState' -> IO (Maybe Terminal)) -> IO (Maybe Terminal)
forall (m :: * -> *) a b.
MonadUnliftIO m =>
MVar a -> (a -> m b) -> m b
withMVar TMState
mvarTMState TMState' -> IO (Maybe Terminal)
go
where
go :: TMState' -> IO (Maybe Terminal)
go :: TMState' -> IO (Maybe Terminal)
go TMState'
tmState = do
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 -> FocusList TMNotebookTab)
-> TMNotebook -> FocusList TMNotebookTab
forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
Maybe Terminal -> IO (Maybe Terminal)
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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TMTerm -> Terminal
term (TMTerm -> Terminal)
-> (TMNotebookTab -> TMTerm) -> TMNotebookTab -> Terminal
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 :: ScrolledWindow -> TMTerm -> Label -> TMNotebookTab
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 :: Notebook -> FocusList TMNotebookTab -> TMNotebook
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 (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 m. Monoid m => m -> m -> m
++ [Item [Widget]
Widget
notePage'])
newTMState :: TMConfig -> Application -> ApplicationWindow -> TMNotebook -> FontDescription -> IO TMState
newTMState :: TMConfig
-> Application
-> ApplicationWindow
-> TMNotebook
-> FontDescription
-> IO TMState
newTMState TMConfig
tmConfig Application
app ApplicationWindow
appWin TMNotebook
note FontDescription
fontDesc =
TMState' -> IO TMState
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar (TMState' -> IO TMState) -> TMState' -> IO TMState
forall a b. (a -> b) -> a -> b
$
TMState :: Application
-> ApplicationWindow
-> TMNotebook
-> FontDescription
-> TMConfig
-> TMState'
TMState
{ tmStateApp :: Application
tmStateApp = Application
app
, tmStateAppWin :: ApplicationWindow
tmStateAppWin = ApplicationWindow
appWin
, tmStateNotebook :: TMNotebook
tmStateNotebook = TMNotebook
note
, tmStateFontDesc :: FontDescription
tmStateFontDesc = FontDescription
fontDesc
, tmStateConfig :: TMConfig
tmStateConfig = TMConfig
tmConfig
}
newEmptyTMState :: TMConfig -> Application -> ApplicationWindow -> Notebook -> FontDescription -> IO TMState
newEmptyTMState :: TMConfig
-> Application
-> ApplicationWindow
-> Notebook
-> FontDescription
-> IO TMState
newEmptyTMState TMConfig
tmConfig Application
app ApplicationWindow
appWin Notebook
note FontDescription
fontDesc =
TMState' -> IO TMState
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar (TMState' -> IO TMState) -> TMState' -> IO TMState
forall a b. (a -> b) -> a -> b
$
TMState :: Application
-> ApplicationWindow
-> TMNotebook
-> FontDescription
-> TMConfig
-> TMState'
TMState
{ tmStateApp :: Application
tmStateApp = Application
app
, tmStateAppWin :: ApplicationWindow
tmStateAppWin = ApplicationWindow
appWin
, tmStateNotebook :: TMNotebook
tmStateNotebook = Notebook -> TMNotebook
createEmptyTMNotebook Notebook
note
, tmStateFontDesc :: FontDescription
tmStateFontDesc = FontDescription
fontDesc
, tmStateConfig :: TMConfig
tmStateConfig = TMConfig
tmConfig
}
newTMStateSingleTerm ::
TMConfig
-> Application
-> ApplicationWindow
-> Notebook
-> Label
-> ScrolledWindow
-> Terminal
-> Int
-> FontDescription
-> IO TMState
newTMStateSingleTerm :: TMConfig
-> Application
-> ApplicationWindow
-> Notebook
-> Label
-> ScrolledWindow
-> Terminal
-> Int
-> FontDescription
-> IO TMState
newTMStateSingleTerm TMConfig
tmConfig Application
app ApplicationWindow
appWin Notebook
note Label
label ScrolledWindow
scrollWin Terminal
trm Int
pd FontDescription
fontDesc = do
TMTerm
tmTerm <- Terminal -> Int -> IO TMTerm
newTMTerm Terminal
trm Int
pd
let tmNoteTab :: TMNotebookTab
tmNoteTab = Label -> ScrolledWindow -> TMTerm -> TMNotebookTab
createTMNotebookTab Label
label ScrolledWindow
scrollWin TMTerm
tmTerm
tabs :: FocusList TMNotebookTab
tabs = TMNotebookTab -> FocusList TMNotebookTab
forall a. a -> FocusList a
singletonFL TMNotebookTab
tmNoteTab
tmNote :: TMNotebook
tmNote = Notebook -> FocusList TMNotebookTab -> TMNotebook
createTMNotebook Notebook
note FocusList TMNotebookTab
tabs
TMConfig
-> Application
-> ApplicationWindow
-> TMNotebook
-> FontDescription
-> IO TMState
newTMState TMConfig
tmConfig Application
app ApplicationWindow
appWin TMNotebook
tmNote FontDescription
fontDesc
traceShowMTMState :: TMState -> IO ()
traceShowMTMState :: TMState -> IO ()
traceShowMTMState TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
TMState' -> IO ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
print TMState'
tmState
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
/= :: FontSize -> FontSize -> Bool
$c/= :: FontSize -> FontSize -> Bool
== :: FontSize -> FontSize -> Bool
$c== :: 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
parseJSONList :: Value -> Parser [FontSize]
$cparseJSONList :: Value -> Parser [FontSize]
parseJSON :: Value -> Parser FontSize
$cparseJSON :: 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
$cto :: forall x. Rep FontSize x -> FontSize
$cfrom :: forall x. FontSize -> Rep FontSize x
Generic, Int -> FontSize -> ShowS
[FontSize] -> ShowS
FontSize -> String
(Int -> FontSize -> ShowS)
-> (FontSize -> String) -> ([FontSize] -> ShowS) -> Show FontSize
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontSize] -> ShowS
$cshowList :: [FontSize] -> ShowS
show :: FontSize -> String
$cshow :: FontSize -> String
showsPrec :: Int -> FontSize -> ShowS
$cshowsPrec :: Int -> FontSize -> ShowS
Show, [FontSize] -> Encoding
[FontSize] -> Value
FontSize -> Encoding
FontSize -> Value
(FontSize -> Value)
-> (FontSize -> Encoding)
-> ([FontSize] -> Value)
-> ([FontSize] -> Encoding)
-> ToJSON FontSize
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FontSize] -> Encoding
$ctoEncodingList :: [FontSize] -> Encoding
toJSONList :: [FontSize] -> Value
$ctoJSONList :: [FontSize] -> Value
toEncoding :: FontSize -> Encoding
$ctoEncoding :: FontSize -> Encoding
toJSON :: FontSize -> Value
$ctoJSON :: FontSize -> Value
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
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
/= :: FontConfig -> FontConfig -> Bool
$c/= :: FontConfig -> FontConfig -> Bool
== :: FontConfig -> FontConfig -> Bool
$c== :: 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
parseJSONList :: Value -> Parser [FontConfig]
$cparseJSONList :: Value -> Parser [FontConfig]
parseJSON :: Value -> Parser FontConfig
$cparseJSON :: 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
$cto :: forall x. Rep FontConfig x -> FontConfig
$cfrom :: forall x. FontConfig -> Rep FontConfig x
Generic, Int -> FontConfig -> ShowS
[FontConfig] -> ShowS
FontConfig -> String
(Int -> FontConfig -> ShowS)
-> (FontConfig -> String)
-> ([FontConfig] -> ShowS)
-> Show FontConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontConfig] -> ShowS
$cshowList :: [FontConfig] -> ShowS
show :: FontConfig -> String
$cshow :: FontConfig -> String
showsPrec :: Int -> FontConfig -> ShowS
$cshowsPrec :: Int -> FontConfig -> ShowS
Show, [FontConfig] -> Encoding
[FontConfig] -> Value
FontConfig -> Encoding
FontConfig -> Value
(FontConfig -> Value)
-> (FontConfig -> Encoding)
-> ([FontConfig] -> Value)
-> ([FontConfig] -> Encoding)
-> ToJSON FontConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [FontConfig] -> Encoding
$ctoEncodingList :: [FontConfig] -> Encoding
toJSONList :: [FontConfig] -> Value
$ctoJSONList :: [FontConfig] -> Value
toEncoding :: FontConfig -> Encoding
$ctoEncoding :: FontConfig -> Encoding
toJSON :: FontConfig -> Value
$ctoJSON :: FontConfig -> Value
ToJSON)
defaultFontConfig :: FontConfig
defaultFontConfig :: FontConfig
defaultFontConfig =
FontConfig :: Text -> FontSize -> FontConfig
FontConfig
{ fontFamily :: Text
fontFamily = Text
"Monospace"
, fontSize :: FontSize
fontSize = FontSize
defaultFontSize
}
data Option a = Unset | Set !a
deriving (Int -> Option a -> ShowS
[Option a] -> ShowS
Option a -> String
(Int -> Option a -> ShowS)
-> (Option a -> String) -> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Option a] -> ShowS
$cshowList :: forall a. Show a => [Option a] -> ShowS
show :: Option a -> String
$cshow :: forall a. Show a => Option a -> String
showsPrec :: Int -> Option a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> 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
readListPrec :: ReadPrec [Option a]
$creadListPrec :: forall a. Read a => ReadPrec [Option a]
readPrec :: ReadPrec (Option a)
$creadPrec :: forall a. Read a => ReadPrec (Option a)
readList :: ReadS [Option a]
$creadList :: forall a. Read a => ReadS [Option a]
readsPrec :: Int -> ReadS (Option a)
$creadsPrec :: forall a. Read a => Int -> ReadS (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
/= :: Option a -> Option a -> Bool
$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
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
min :: Option a -> Option a -> Option a
$cmin :: forall a. Ord a => Option a -> Option a -> Option a
max :: Option a -> Option a -> Option a
$cmax :: forall a. Ord a => Option a -> Option a -> Option a
>= :: 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
$c< :: forall a. Ord a => Option a -> Option a -> Bool
compare :: Option a -> Option a -> Ordering
$ccompare :: forall a. Ord a => Option a -> Option a -> Ordering
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
<$ :: forall a b. a -> Option b -> Option a
$c<$ :: forall a b. a -> Option b -> Option a
fmap :: forall a b. (a -> b) -> Option a -> Option b
$cfmap :: forall a b. (a -> b) -> Option a -> Option b
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
product :: forall a. Num a => Option a -> a
$cproduct :: forall a. Num a => Option a -> a
sum :: forall a. Num a => Option a -> a
$csum :: forall a. Num a => Option a -> a
minimum :: forall a. Ord a => Option a -> a
$cminimum :: forall a. Ord a => Option a -> a
maximum :: forall a. Ord a => Option a -> a
$cmaximum :: forall a. Ord a => Option a -> a
elem :: forall a. Eq a => a -> Option a -> Bool
$celem :: forall a. Eq a => a -> Option a -> Bool
length :: forall a. Option a -> Int
$clength :: forall a. Option a -> Int
null :: forall a. Option a -> Bool
$cnull :: forall a. Option a -> Bool
toList :: forall a. Option a -> [a]
$ctoList :: forall a. Option a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Option a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Option a -> a
foldr1 :: forall a. (a -> a -> a) -> Option a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Option a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> Option a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Option a -> m
fold :: forall m. Monoid m => Option m -> m
$cfold :: forall m. Monoid m => Option m -> m
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
enumFromThenTo :: ShowScrollbar -> ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
$cenumFromThenTo :: ShowScrollbar -> ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
enumFromTo :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
$cenumFromTo :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
enumFromThen :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
$cenumFromThen :: ShowScrollbar -> ShowScrollbar -> [ShowScrollbar]
enumFrom :: ShowScrollbar -> [ShowScrollbar]
$cenumFrom :: ShowScrollbar -> [ShowScrollbar]
fromEnum :: ShowScrollbar -> Int
$cfromEnum :: ShowScrollbar -> Int
toEnum :: Int -> ShowScrollbar
$ctoEnum :: Int -> ShowScrollbar
pred :: ShowScrollbar -> ShowScrollbar
$cpred :: ShowScrollbar -> ShowScrollbar
succ :: ShowScrollbar -> ShowScrollbar
$csucc :: ShowScrollbar -> ShowScrollbar
Enum, ShowScrollbar -> ShowScrollbar -> Bool
(ShowScrollbar -> ShowScrollbar -> Bool)
-> (ShowScrollbar -> ShowScrollbar -> Bool) -> Eq ShowScrollbar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowScrollbar -> ShowScrollbar -> Bool
$c/= :: ShowScrollbar -> ShowScrollbar -> Bool
== :: ShowScrollbar -> ShowScrollbar -> Bool
$c== :: 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
$cto :: forall x. Rep ShowScrollbar x -> ShowScrollbar
$cfrom :: forall x. ShowScrollbar -> Rep ShowScrollbar x
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
parseJSONList :: Value -> Parser [ShowScrollbar]
$cparseJSONList :: Value -> Parser [ShowScrollbar]
parseJSON :: Value -> Parser ShowScrollbar
$cparseJSON :: Value -> Parser ShowScrollbar
FromJSON, Int -> ShowScrollbar -> ShowS
[ShowScrollbar] -> ShowS
ShowScrollbar -> String
(Int -> ShowScrollbar -> ShowS)
-> (ShowScrollbar -> String)
-> ([ShowScrollbar] -> ShowS)
-> Show ShowScrollbar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShowScrollbar] -> ShowS
$cshowList :: [ShowScrollbar] -> ShowS
show :: ShowScrollbar -> String
$cshow :: ShowScrollbar -> String
showsPrec :: Int -> ShowScrollbar -> ShowS
$cshowsPrec :: Int -> ShowScrollbar -> ShowS
Show, [ShowScrollbar] -> Encoding
[ShowScrollbar] -> Value
ShowScrollbar -> Encoding
ShowScrollbar -> Value
(ShowScrollbar -> Value)
-> (ShowScrollbar -> Encoding)
-> ([ShowScrollbar] -> Value)
-> ([ShowScrollbar] -> Encoding)
-> ToJSON ShowScrollbar
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ShowScrollbar] -> Encoding
$ctoEncodingList :: [ShowScrollbar] -> Encoding
toJSONList :: [ShowScrollbar] -> Value
$ctoJSONList :: [ShowScrollbar] -> Value
toEncoding :: ShowScrollbar -> Encoding
$ctoEncoding :: ShowScrollbar -> Encoding
toJSON :: ShowScrollbar -> Value
$ctoJSON :: ShowScrollbar -> Value
ToJSON)
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
enumFromThenTo :: ShowTabBar -> ShowTabBar -> ShowTabBar -> [ShowTabBar]
$cenumFromThenTo :: ShowTabBar -> ShowTabBar -> ShowTabBar -> [ShowTabBar]
enumFromTo :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
$cenumFromTo :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
enumFromThen :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
$cenumFromThen :: ShowTabBar -> ShowTabBar -> [ShowTabBar]
enumFrom :: ShowTabBar -> [ShowTabBar]
$cenumFrom :: ShowTabBar -> [ShowTabBar]
fromEnum :: ShowTabBar -> Int
$cfromEnum :: ShowTabBar -> Int
toEnum :: Int -> ShowTabBar
$ctoEnum :: Int -> ShowTabBar
pred :: ShowTabBar -> ShowTabBar
$cpred :: ShowTabBar -> ShowTabBar
succ :: ShowTabBar -> ShowTabBar
$csucc :: ShowTabBar -> ShowTabBar
Enum, ShowTabBar -> ShowTabBar -> Bool
(ShowTabBar -> ShowTabBar -> Bool)
-> (ShowTabBar -> ShowTabBar -> Bool) -> Eq ShowTabBar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShowTabBar -> ShowTabBar -> Bool
$c/= :: ShowTabBar -> ShowTabBar -> Bool
== :: ShowTabBar -> ShowTabBar -> Bool
$c== :: 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
$cto :: forall x. Rep ShowTabBar x -> ShowTabBar
$cfrom :: forall x. ShowTabBar -> Rep ShowTabBar x
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
parseJSONList :: Value -> Parser [ShowTabBar]
$cparseJSONList :: Value -> Parser [ShowTabBar]
parseJSON :: Value -> Parser ShowTabBar
$cparseJSON :: Value -> Parser ShowTabBar
FromJSON, Int -> ShowTabBar -> ShowS
[ShowTabBar] -> ShowS
ShowTabBar -> String
(Int -> ShowTabBar -> ShowS)
-> (ShowTabBar -> String)
-> ([ShowTabBar] -> ShowS)
-> Show ShowTabBar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShowTabBar] -> ShowS
$cshowList :: [ShowTabBar] -> ShowS
show :: ShowTabBar -> String
$cshow :: ShowTabBar -> String
showsPrec :: Int -> ShowTabBar -> ShowS
$cshowsPrec :: Int -> ShowTabBar -> ShowS
Show, [ShowTabBar] -> Encoding
[ShowTabBar] -> Value
ShowTabBar -> Encoding
ShowTabBar -> Value
(ShowTabBar -> Value)
-> (ShowTabBar -> Encoding)
-> ([ShowTabBar] -> Value)
-> ([ShowTabBar] -> Encoding)
-> ToJSON ShowTabBar
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ShowTabBar] -> Encoding
$ctoEncodingList :: [ShowTabBar] -> Encoding
toJSONList :: [ShowTabBar] -> Value
$ctoJSONList :: [ShowTabBar] -> Value
toEncoding :: ShowTabBar -> Encoding
$ctoEncoding :: ShowTabBar -> Encoding
toJSON :: ShowTabBar -> Value
$ctoJSON :: ShowTabBar -> Value
ToJSON)
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
} deriving (ConfigOptions -> ConfigOptions -> Bool
(ConfigOptions -> ConfigOptions -> Bool)
-> (ConfigOptions -> ConfigOptions -> Bool) -> Eq ConfigOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigOptions -> ConfigOptions -> Bool
$c/= :: ConfigOptions -> ConfigOptions -> Bool
== :: ConfigOptions -> ConfigOptions -> Bool
$c== :: 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
$cto :: forall x. Rep ConfigOptions x -> ConfigOptions
$cfrom :: forall x. ConfigOptions -> Rep ConfigOptions x
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
parseJSONList :: Value -> Parser [ConfigOptions]
$cparseJSONList :: Value -> Parser [ConfigOptions]
parseJSON :: Value -> Parser ConfigOptions
$cparseJSON :: Value -> Parser ConfigOptions
FromJSON, Int -> ConfigOptions -> ShowS
[ConfigOptions] -> ShowS
ConfigOptions -> String
(Int -> ConfigOptions -> ShowS)
-> (ConfigOptions -> String)
-> ([ConfigOptions] -> ShowS)
-> Show ConfigOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigOptions] -> ShowS
$cshowList :: [ConfigOptions] -> ShowS
show :: ConfigOptions -> String
$cshow :: ConfigOptions -> String
showsPrec :: Int -> ConfigOptions -> ShowS
$cshowsPrec :: Int -> ConfigOptions -> ShowS
Show, [ConfigOptions] -> Encoding
[ConfigOptions] -> Value
ConfigOptions -> Encoding
ConfigOptions -> Value
(ConfigOptions -> Value)
-> (ConfigOptions -> Encoding)
-> ([ConfigOptions] -> Value)
-> ([ConfigOptions] -> Encoding)
-> ToJSON ConfigOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ConfigOptions] -> Encoding
$ctoEncodingList :: [ConfigOptions] -> Encoding
toJSONList :: [ConfigOptions] -> Value
$ctoJSONList :: [ConfigOptions] -> Value
toEncoding :: ConfigOptions -> Encoding
$ctoEncoding :: ConfigOptions -> Encoding
toJSON :: ConfigOptions -> Value
$ctoJSON :: ConfigOptions -> Value
ToJSON)
instance FromJSON CursorBlinkMode where
parseJSON :: Value -> Parser CursorBlinkMode
parseJSON = String
-> (Text -> Parser CursorBlinkMode)
-> Value
-> Parser CursorBlinkMode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"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 (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeSystem
Text
"CursorBlinkModeOn" -> CursorBlinkMode -> Parser CursorBlinkMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeOn
Text
"CursorBlinkModeOff" -> CursorBlinkMode -> Parser CursorBlinkMode
forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeOff
Text
_ -> String -> Parser CursorBlinkMode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"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
-> ShowScrollbar
-> Integer
-> Bool
-> Text
-> Bool
-> ShowTabBar
-> CursorBlinkMode
-> Bool
-> Bool
-> ConfigOptions
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
}
data TMConfig = TMConfig
{ TMConfig -> ConfigOptions
options :: !ConfigOptions
, TMConfig -> ConfigHooks
hooks :: !ConfigHooks
} deriving Int -> TMConfig -> ShowS
[TMConfig] -> ShowS
TMConfig -> String
(Int -> TMConfig -> ShowS)
-> (TMConfig -> String) -> ([TMConfig] -> ShowS) -> Show TMConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TMConfig] -> ShowS
$cshowList :: [TMConfig] -> ShowS
show :: TMConfig -> String
$cshow :: TMConfig -> String
showsPrec :: Int -> TMConfig -> ShowS
$cshowsPrec :: Int -> TMConfig -> ShowS
Show
defaultTMConfig :: TMConfig
defaultTMConfig :: TMConfig
defaultTMConfig =
TMConfig :: ConfigOptions -> ConfigHooks -> TMConfig
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
_ =
String -> ShowS
showString String
"ConfigHooks {" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"createTermHook = <function>" ShowS -> ShowS -> ShowS
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
String -> ShowS
showString String
"}"
defaultConfigHooks :: ConfigHooks
defaultConfigHooks :: ConfigHooks
defaultConfigHooks =
ConfigHooks :: (TMState -> Terminal -> IO ()) -> ConfigHooks
ConfigHooks
{ createTermHook :: TMState -> Terminal -> IO ()
createTermHook = TMState -> Terminal -> IO ()
defaultCreateTermHook
}
defaultCreateTermHook :: TMState -> Terminal -> IO ()
defaultCreateTermHook :: TMState -> Terminal -> IO ()
defaultCreateTermHook TMState
_ Terminal
_ = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
data FocusNotSameErr
= FocusListFocusExistsButNoNotebookTabWidget
| NotebookTabWidgetDiffersFromFocusListFocus
| NotebookTabWidgetExistsButNoFocusListFocus
deriving Int -> FocusNotSameErr -> ShowS
[FocusNotSameErr] -> ShowS
FocusNotSameErr -> String
(Int -> FocusNotSameErr -> ShowS)
-> (FocusNotSameErr -> String)
-> ([FocusNotSameErr] -> ShowS)
-> Show FocusNotSameErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FocusNotSameErr] -> ShowS
$cshowList :: [FocusNotSameErr] -> ShowS
show :: FocusNotSameErr -> String
$cshow :: FocusNotSameErr -> String
showsPrec :: Int -> FocusNotSameErr -> ShowS
$cshowsPrec :: Int -> FocusNotSameErr -> ShowS
Show
data TabsDoNotMatch
= TabLengthsDifferent Int Int
| TabAtIndexDifferent Int
deriving (Int -> TabsDoNotMatch -> ShowS
[TabsDoNotMatch] -> ShowS
TabsDoNotMatch -> String
(Int -> TabsDoNotMatch -> ShowS)
-> (TabsDoNotMatch -> String)
-> ([TabsDoNotMatch] -> ShowS)
-> Show TabsDoNotMatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TabsDoNotMatch] -> ShowS
$cshowList :: [TabsDoNotMatch] -> ShowS
show :: TabsDoNotMatch -> String
$cshow :: TabsDoNotMatch -> String
showsPrec :: Int -> TabsDoNotMatch -> ShowS
$cshowsPrec :: Int -> TabsDoNotMatch -> ShowS
Show)
data TMStateInvariantErr
= FocusNotSame FocusNotSameErr Int
| TabsDoNotMatch TabsDoNotMatch
deriving Int -> TMStateInvariantErr -> ShowS
[TMStateInvariantErr] -> ShowS
TMStateInvariantErr -> String
(Int -> TMStateInvariantErr -> ShowS)
-> (TMStateInvariantErr -> String)
-> ([TMStateInvariantErr] -> ShowS)
-> Show TMStateInvariantErr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TMStateInvariantErr] -> ShowS
$cshowList :: [TMStateInvariantErr] -> ShowS
show :: TMStateInvariantErr -> String
$cshow :: TMStateInvariantErr -> String
showsPrec :: Int -> TMStateInvariantErr -> ShowS
$cshowsPrec :: Int -> TMStateInvariantErr -> ShowS
Show
invariantTMState' :: TMState' -> IO [TMStateInvariantErr]
invariantTMState' :: TMState' -> IO [TMStateInvariantErr]
invariantTMState' TMState'
tmState =
[IO (Maybe TMStateInvariantErr)] -> IO [TMStateInvariantErr]
runInvariants
[ IO (Maybe TMStateInvariantErr)
Item [IO (Maybe TMStateInvariantErr)]
invariantFocusSame
, IO (Maybe TMStateInvariantErr)
Item [IO (Maybe TMStateInvariantErr)]
invariantTMTabLength
, IO (Maybe TMStateInvariantErr)
Item [IO (Maybe TMStateInvariantErr)]
invariantTabsAllMatch
]
where
runInvariants :: [IO (Maybe TMStateInvariantErr)] -> IO [TMStateInvariantErr]
runInvariants :: [IO (Maybe TMStateInvariantErr)] -> IO [TMStateInvariantErr]
runInvariants = ([Maybe TMStateInvariantErr] -> [TMStateInvariantErr])
-> IO [Maybe TMStateInvariantErr] -> IO [TMStateInvariantErr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe TMStateInvariantErr] -> [TMStateInvariantErr]
forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes (IO [Maybe TMStateInvariantErr] -> IO [TMStateInvariantErr])
-> ([IO (Maybe TMStateInvariantErr)]
-> IO [Maybe TMStateInvariantErr])
-> [IO (Maybe TMStateInvariantErr)]
-> IO [TMStateInvariantErr]
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [IO (Maybe TMStateInvariantErr)] -> IO [Maybe TMStateInvariantErr]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
invariantFocusSame :: IO (Maybe TMStateInvariantErr)
invariantFocusSame :: IO (Maybe TMStateInvariantErr)
invariantFocusSame = do
let tmNote :: Notebook
tmNote = TMNotebook -> Notebook
tmNotebook (TMNotebook -> Notebook) -> TMNotebook -> Notebook
forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
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
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
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 TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMStateInvariantErr
forall a. Maybe a
Nothing
(Just Widget
_, Maybe ScrolledWindow
Nothing) ->
Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr))
-> Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall a b. (a -> b) -> a -> b
$
TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a. a -> Maybe a
Just (TMStateInvariantErr -> Maybe TMStateInvariantErr)
-> TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a b. (a -> b) -> a -> b
$
FocusNotSameErr -> Int -> TMStateInvariantErr
FocusNotSame FocusNotSameErr
NotebookTabWidgetExistsButNoFocusListFocus Int
idx
(Maybe Widget
Nothing, Just ScrolledWindow
_) ->
Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr))
-> Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall a b. (a -> b) -> a -> b
$
TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a. a -> Maybe a
Just (TMStateInvariantErr -> Maybe TMStateInvariantErr)
-> TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a b. (a -> b) -> a -> b
$
FocusNotSameErr -> Int -> TMStateInvariantErr
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 TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMStateInvariantErr
forall a. Maybe a
Nothing
else
Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr))
-> Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall a b. (a -> b) -> a -> b
$
TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a. a -> Maybe a
Just (TMStateInvariantErr -> Maybe TMStateInvariantErr)
-> TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a b. (a -> b) -> a -> b
$
FocusNotSameErr -> Int -> TMStateInvariantErr
FocusNotSame FocusNotSameErr
NotebookTabWidgetDiffersFromFocusListFocus Int
idx
invariantTMTabLength :: IO (Maybe TMStateInvariantErr)
invariantTMTabLength :: IO (Maybe TMStateInvariantErr)
invariantTMTabLength = do
let tmNote :: Notebook
tmNote = TMNotebook -> Notebook
tmNotebook (TMNotebook -> Notebook) -> TMNotebook -> Notebook
forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
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
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
lengthEqual :: Bool
lengthEqual = Int
focusListLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
noteLength
if Bool
lengthEqual
then Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMStateInvariantErr
forall a. Maybe a
Nothing
else Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr))
-> Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall a b. (a -> b) -> a -> b
$
TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a. a -> Maybe a
Just (TMStateInvariantErr -> Maybe TMStateInvariantErr)
-> TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a b. (a -> b) -> a -> b
$
TabsDoNotMatch -> TMStateInvariantErr
TabsDoNotMatch (TabsDoNotMatch -> TMStateInvariantErr)
-> TabsDoNotMatch -> TMStateInvariantErr
forall a b. (a -> b) -> a -> b
$
Int -> Int -> TabsDoNotMatch
TabLengthsDifferent Int
noteLength Int
focusListLength
invariantTabsAllMatch :: IO (Maybe TMStateInvariantErr)
invariantTabsAllMatch :: IO (Maybe TMStateInvariantErr)
invariantTabsAllMatch = do
let tmNote :: Notebook
tmNote = TMNotebook -> Notebook
tmNotebook (TMNotebook -> Notebook) -> TMNotebook -> Notebook
forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
focusList :: FocusList TMNotebookTab
focusList = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs (TMNotebook -> FocusList TMNotebookTab)
-> TMNotebook -> FocusList TMNotebookTab
forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
flList :: [ScrolledWindow]
flList = TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer (TMNotebookTab -> ScrolledWindow)
-> [TMNotebookTab] -> [ScrolledWindow]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FocusList TMNotebookTab -> [Element (FocusList TMNotebookTab)]
forall mono. MonoFoldable mono => mono -> [Element mono]
toList FocusList TMNotebookTab
focusList
[Widget]
noteList <- Notebook -> IO [Widget]
notebookToList Notebook
tmNote
[Widget] -> [ScrolledWindow] -> IO (Maybe TMStateInvariantErr)
forall a b.
(IsWidget a, IsWidget b) =>
[a] -> [b] -> IO (Maybe TMStateInvariantErr)
tabsMatch [Widget]
noteList [ScrolledWindow]
flList
where
tabsMatch
:: forall a b
. (IsWidget a, IsWidget b)
=> [a]
-> [b]
-> IO (Maybe TMStateInvariantErr)
tabsMatch :: forall a b.
(IsWidget a, IsWidget b) =>
[a] -> [b] -> IO (Maybe TMStateInvariantErr)
tabsMatch [a]
xs [b]
ys = (Element [(a, b, Int)]
-> IO (Maybe TMStateInvariantErr)
-> IO (Maybe TMStateInvariantErr))
-> IO (Maybe TMStateInvariantErr)
-> [(a, b, Int)]
-> IO (Maybe TMStateInvariantErr)
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
foldr (a, b, Int)
-> IO (Maybe TMStateInvariantErr) -> IO (Maybe TMStateInvariantErr)
Element [(a, b, Int)]
-> IO (Maybe TMStateInvariantErr) -> IO (Maybe TMStateInvariantErr)
go (Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TMStateInvariantErr
forall a. Maybe a
Nothing) ([a] -> [b] -> [Int] -> [(a, b, Int)]
forall (f :: * -> *) a b c.
Zip3 f =>
f a -> f b -> f c -> f (a, b, c)
zip3 [a]
xs [b]
ys [Item [Int]
0..])
where
go :: (a, b, Int) -> IO (Maybe TMStateInvariantErr) -> IO (Maybe TMStateInvariantErr)
go :: (a, b, Int)
-> IO (Maybe TMStateInvariantErr) -> IO (Maybe TMStateInvariantErr)
go (a
x, b
y, Int
i) IO (Maybe TMStateInvariantErr)
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 TMStateInvariantErr)
acc
else Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe TMStateInvariantErr -> IO (Maybe TMStateInvariantErr))
-> (TMStateInvariantErr -> Maybe TMStateInvariantErr)
-> TMStateInvariantErr
-> IO (Maybe TMStateInvariantErr)
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TMStateInvariantErr -> Maybe TMStateInvariantErr
forall a. a -> Maybe a
Just (TMStateInvariantErr -> IO (Maybe TMStateInvariantErr))
-> TMStateInvariantErr -> IO (Maybe TMStateInvariantErr)
forall a b. (a -> b) -> a -> b
$ TabsDoNotMatch -> TMStateInvariantErr
TabsDoNotMatch (Int -> TabsDoNotMatch
TabAtIndexDifferent Int
i)
assertInvariantTMState :: TMState -> IO ()
assertInvariantTMState :: TMState -> IO ()
assertInvariantTMState TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
[TMStateInvariantErr]
assertValue <- TMState' -> IO [TMStateInvariantErr]
invariantTMState' TMState'
tmState
case [TMStateInvariantErr]
assertValue of
[] x-> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
errs :: [TMStateInvariantErr]
errs@(TMStateInvariantErr
_:[TMStateInvariantErr]
_) -> do
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"In assertInvariantTMState, some invariants for TMState are being violated."
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"\nInvariants violated:"
[TMStateInvariantErr] -> IO ()
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
print [TMStateInvariantErr]
errs
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"\nTMState:"
TMState' -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint TMState'
tmState
Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
""
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invariants violated for TMState"
pPrintTMState :: TMState -> IO ()
pPrintTMState :: TMState -> IO ()
pPrintTMState TMState
mvarTMState = do
TMState'
tmState <- TMState -> IO TMState'
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
TMState' -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint TMState'
tmState