{-# 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"TMTerm {" 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 = " 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)" 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
", " 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 = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d forall a. Num a => a -> a -> a
+ Int
1) Int
pid 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
", " 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 = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d forall a. Num a => a -> a -> a
+ Int
1) (Unique -> Int
hashUnique Unique
unique) 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"TMNotebookTab {" 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 = " 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)" 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
", " 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 = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d forall a. Num a => a -> a -> a
+ Int
1) TMTerm
tmNotebookTabTerm 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
", " 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 = " 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)" 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"TMNotebook {" 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 = " 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)" 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
", " 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 = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d forall a. Num a => a -> a -> a
+ Int
1) FocusList TMNotebookTab
tmNotebookTabs 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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"TMState {" 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 = " 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)" 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
", " 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 = " 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)" 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
", " 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 = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d forall a. Num a => a -> a -> a
+ Int
1) TMNotebook
tmStateNotebook 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
", " 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 = " 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)" 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
", " 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 = " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
forall a. Show a => Int -> a -> ShowS
showsPrec (Int
d forall a. Num a => a -> a -> a
+ Int
1) TMConfig
tmStateConfig 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
(==) = forall a. Eq a => a -> a -> 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
(==) = forall a. Eq a => a -> a -> 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 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 =
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 =
forall a. FocusList a -> Maybe a
getFocusItemFL forall a b. (a -> b) -> a -> b
$ TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TMTerm -> Terminal
term 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
{ 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 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 <- 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 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure [Widget]
acc
Just Widget
notePage' -> Int32 -> [Widget] -> IO [Widget]
unfoldHelper (Int32
index32 forall a. Num a => a -> a -> a
+ Int32
1) ([Widget]
acc forall m. Monoid m => m -> m -> m
++ [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 =
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$
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 =
forall (m :: * -> *) a. MonadIO m => a -> m (MVar a)
newMVar forall a b. (a -> b) -> a -> b
$
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 = 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 <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
print TMState'
tmState
data FontSize
= FontSizePoints Int
| FontSizeUnits Double
deriving (FontSize -> FontSize -> Bool
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
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. 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
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
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 forall a. Num a => a -> a -> a
+ Int
i
in Int -> FontSize
FontSizePoints forall a b. (a -> b) -> a -> b
$ if Int
newPoints 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 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
in Double -> FontSize
FontSizeUnits forall a b. (a -> b) -> a -> b
$ if Double
newUnits 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
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
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. 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
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
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
{ fontFamily :: Text
fontFamily = Text
"Monospace"
, fontSize :: FontSize
fontSize = FontSize
defaultFontSize
}
data Option a = Unset | Set !a
deriving (Int -> Option a -> ShowS
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)
ReadS [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
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, Option a -> Option a -> Bool
Option a -> Option a -> Ordering
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 -> 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 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 -> forall a b. a -> b -> a
const 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]
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
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. 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
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
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
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]
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
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. 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
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
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
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
, ConfigOptions -> Bool
allowBold :: !Bool
} deriving (ConfigOptions -> ConfigOptions -> Bool
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. 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
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
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
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 = forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"CursorBlinkMode" forall a b. (a -> b) -> a -> b
$ \Text
c -> do
case (Text
c :: Text) of
Text
"CursorBlinkModeSystem" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeSystem
Text
"CursorBlinkModeOn" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeOn
Text
"CursorBlinkModeOff" -> forall (f :: * -> *) a. Applicative f => a -> f a
pure CursorBlinkMode
CursorBlinkModeOff
Text
_ -> 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 :: 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 -> String
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
{ 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 {" 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>" 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
{ createTermHook :: TMState -> Terminal -> IO ()
createTermHook = TMState -> Terminal -> IO ()
defaultCreateTermHook
}
defaultCreateTermHook :: TMState -> Terminal -> IO ()
defaultCreateTermHook :: TMState -> Terminal -> IO ()
defaultCreateTermHook TMState
_ Terminal
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
data FocusNotSameErr
= FocusListFocusExistsButNoNotebookTabWidget
| NotebookTabWidgetDiffersFromFocusListFocus
| NotebookTabWidgetExistsButNoFocusListFocus
deriving Int -> FocusNotSameErr -> ShowS
[FocusNotSameErr] -> ShowS
FocusNotSameErr -> String
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
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
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)
invariantFocusSame
, IO (Maybe TMStateInvariantErr)
invariantTMTabLength
, IO (Maybe TMStateInvariantErr)
invariantTabsAllMatch
]
where
runInvariants :: [IO (Maybe TMStateInvariantErr)] -> IO [TMStateInvariantErr]
runInvariants :: [IO (Maybe TMStateInvariantErr)] -> IO [TMStateInvariantErr]
runInvariants = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) t.
(IsSequence (f (Maybe t)), Functor f,
Element (f (Maybe t)) ~ Maybe t) =>
f (Maybe t) -> f t
catMaybes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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 forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
Int32
index32 <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> m Int32
notebookGetCurrentPage Notebook
tmNote
Maybe Widget
maybeWidgetFromNote <- 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 forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
maybeScrollWinFromFL :: Maybe ScrolledWindow
maybeScrollWinFromFL =
TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FocusList a -> Maybe a
getFocusItemFL FocusList TMNotebookTab
focusList
idx :: Int
idx = 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) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
(Just Widget
_, Maybe ScrolledWindow
Nothing) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
FocusNotSameErr -> Int -> TMStateInvariantErr
FocusNotSame FocusNotSameErr
NotebookTabWidgetExistsButNoFocusListFocus Int
idx
(Maybe Widget
Nothing, Just ScrolledWindow
_) ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
FocusNotSameErr -> Int -> TMStateInvariantErr
FocusNotSame FocusNotSameErr
FocusListFocusExistsButNoNotebookTabWidget Int
idx
(Just Widget
widgetFromNote, Just ScrolledWindow
scrollWinFromFL) -> do
Bool
isEq <- forall (m :: * -> *) a b.
(MonadIO m, IsWidget a, IsWidget b) =>
a -> b -> m Bool
widgetEq Widget
widgetFromNote ScrolledWindow
scrollWinFromFL
if Bool
isEq
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just 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 forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
Int32
noteLength32 <- forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsNotebook a) =>
a -> m Int32
notebookGetNPages Notebook
tmNote
let noteLength :: Int
noteLength = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
noteLength32
focusListLength :: Int
focusListLength = forall a. FocusList a -> Int
lengthFL forall a b. (a -> b) -> a -> b
$ TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
lengthEqual :: Bool
lengthEqual = Int
focusListLength forall a. Eq a => a -> a -> Bool
== Int
noteLength
if Bool
lengthEqual
then forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
TabsDoNotMatch -> TMStateInvariantErr
TabsDoNotMatch 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 forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
focusList :: FocusList TMNotebookTab
focusList = TMNotebook -> FocusList TMNotebookTab
tmNotebookTabs forall a b. (a -> b) -> a -> b
$ TMState' -> TMNotebook
tmStateNotebook TMState'
tmState
flList :: [ScrolledWindow]
flList = TMNotebookTab -> ScrolledWindow
tmNotebookTabTermContainer forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall mono. MonoFoldable mono => mono -> [Element mono]
toList FocusList TMNotebookTab
focusList
[Widget]
noteList <- Notebook -> IO [Widget]
notebookToList Notebook
tmNote
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 = forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
foldr (a, b, Int)
-> IO (Maybe TMStateInvariantErr) -> IO (Maybe TMStateInvariantErr)
go (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) (forall (f :: * -> *) a b c.
Zip3 f =>
f a -> f b -> f c -> f (a, b, c)
zip3 [a]
xs [b]
ys [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 <- 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 forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just 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 <- 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-> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
errs :: [TMStateInvariantErr]
errs@(TMStateInvariantErr
_:[TMStateInvariantErr]
_) -> do
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"In assertInvariantTMState, some invariants for TMState are being violated."
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"\nInvariants violated:"
forall a (m :: * -> *). (Show a, MonadIO m) => a -> m ()
print [TMStateInvariantErr]
errs
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
"\nTMState:"
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint TMState'
tmState
forall (m :: * -> *). MonadIO m => Text -> m ()
putStrLn Text
""
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 <- forall (m :: * -> *) a. MonadIO m => MVar a -> m a
readMVar TMState
mvarTMState
forall (m :: * -> *) a. (MonadIO m, Show a) => a -> m ()
pPrint TMState'
tmState