module Matterhorn.App
( runMatterhorn
, closeMatterhorn
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Control.Monad.Trans.Except ( runExceptT )
import qualified Graphics.Vty as Vty
import Text.Aspell ( stopAspell )
import GHC.Conc (getNumProcessors, setNumCapabilities)
import System.Posix.IO ( stdInput )
import Network.Mattermost
import Matterhorn.Config
import Matterhorn.Draw
import qualified Matterhorn.Events as Events
import Matterhorn.IOUtil
import Matterhorn.InputHistory
import Matterhorn.LastRunState
import Matterhorn.Options hiding ( ShowHelp )
import Matterhorn.State.Setup
import Matterhorn.State.Setup.Threads.Logging ( shutdownLogManager )
import Matterhorn.Types
app :: App ChatState MHEvent Name
app :: App ChatState MHEvent Name
app =
App { appDraw :: ChatState -> [Widget Name]
appDraw = ChatState -> [Widget Name]
draw
, appHandleEvent :: BrickEvent Name MHEvent -> EventM Name ChatState ()
appHandleEvent = BrickEvent Name MHEvent -> EventM Name ChatState ()
Events.onEvent
, appStartEvent :: EventM Name ChatState ()
appStartEvent = forall (m :: * -> *) a. Monad m => a -> m a
return ()
, appAttrMap :: ChatState -> AttrMap
appAttrMap = (forall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources AttrMap
crTheme)
, appChooseCursor :: ChatState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = \ChatState
s [CursorLocation Name]
cs -> do
TeamId
tId <- ChatState
sforall s a. s -> Getting a s a -> a
^.SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
[CursorLocation Name]
-> ChatState -> TeamId -> Mode -> Maybe (CursorLocation Name)
cursorByMode [CursorLocation Name]
cs ChatState
s TeamId
tId (TeamState -> Mode
teamMode forall a b. (a -> b) -> a -> b
$ ChatState
sforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId))
}
cursorByMode :: [CursorLocation Name] -> ChatState -> TeamId -> Mode -> Maybe (CursorLocation Name)
cursorByMode :: [CursorLocation Name]
-> ChatState -> TeamId -> Mode -> Maybe (CursorLocation Name)
cursorByMode [CursorLocation Name]
cs ChatState
s TeamId
tId Mode
mode =
case Mode
mode of
Mode
Main -> case ChatState
sforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus of
MessageInterfaceFocus
FocusCurrentChannel -> do
ChannelId
cId <- ChatState
sforall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
ChannelMessageInterface
mi <- ChatState
sforall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ChannelMessageInterface
maybeChannelMessageInterface(ChannelId
cId)
Name
cur <- forall n i. MessageInterface n i -> Maybe n
messageInterfaceCursor ChannelMessageInterface
mi
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed Name
cur [CursorLocation Name]
cs
MessageInterfaceFocus
FocusThread -> do
ThreadInterface
ti <- ChatState
sforall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)forall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface
Name
cur <- forall n i. MessageInterface n i -> Maybe n
messageInterfaceCursor ThreadInterface
ti
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed Name
cur [CursorLocation Name]
cs
Mode
LeaveChannelConfirm -> forall a. Maybe a
Nothing
Mode
DeleteChannelConfirm -> forall a. Maybe a
Nothing
MessageSelectDeleteConfirm {} -> forall a. Maybe a
Nothing
(PostListWindow {}) -> forall a. Maybe a
Nothing
Mode
ViewMessage -> forall a. Maybe a
Nothing
(ShowHelp {}) -> forall a. Maybe a
Nothing
Mode
EditNotifyPrefs -> forall a. Maybe a
Nothing
Mode
ChannelSelect -> forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
Mode
UserListWindow -> forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
Mode
ReactionEmojiListWindow -> forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
Mode
ChannelListWindow -> forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
Mode
ThemeListWindow -> forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
Mode
ChannelTopicWindow -> forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed (TeamId -> Name
ChannelTopicEditor TeamId
tId) [CursorLocation Name]
cs
applicationMaxCPUs :: Int
applicationMaxCPUs :: Int
applicationMaxCPUs = Int
2
setupCpuUsage :: Config -> IO ()
setupCpuUsage :: Config -> IO ()
setupCpuUsage Config
config = do
Int
actualNumCpus <- IO Int
getNumProcessors
let requestedCPUs :: Int
requestedCPUs = case Config -> CPUUsagePolicy
configCpuUsagePolicy Config
config of
CPUUsagePolicy
SingleCPU -> Int
1
CPUUsagePolicy
MultipleCPUs -> forall a. Ord a => a -> a -> a
min Int
applicationMaxCPUs Int
actualNumCpus
Int -> IO ()
setNumCapabilities Int
requestedCPUs
runMatterhorn :: Options -> Config -> IO ChatState
runMatterhorn :: Options -> Config -> IO ChatState
runMatterhorn Options
opts Config
config = do
Config -> IO ()
setupCpuUsage Config
config
let mkVty :: IO Vty
mkVty = do
Maybe Char
mEraseChar <- Fd -> IO (Maybe Char)
Vty.getTtyEraseChar Fd
stdInput
let addEraseChar :: Config -> Config
addEraseChar Config
cfg = case Maybe Char
mEraseChar of
Maybe Char
Nothing -> Config
cfg
Just Char
ch -> Config
cfg { inputMap :: InputMap
Vty.inputMap = (forall a. Maybe a
Nothing, [Char
ch], Key -> [Modifier] -> Event
Vty.EvKey Key
Vty.KBS []) forall a. a -> [a] -> [a]
: Config -> InputMap
Vty.inputMap Config
cfg }
Vty
vty <- Config -> IO Vty
Vty.mkVty forall a b. (a -> b) -> a -> b
$ Config -> Config
addEraseChar Config
Vty.defaultConfig
let output :: Output
output = Vty -> Output
Vty.outputIface Vty
vty
Output -> Mode -> Bool -> IO ()
Vty.setMode Output
output Mode
Vty.BracketedPaste Bool
True
Output -> Mode -> Bool -> IO ()
Vty.setMode Output
output Mode
Vty.Hyperlink forall a b. (a -> b) -> a -> b
$ Config -> Bool
configHyperlinkingMode Config
config
Output -> Mode -> Bool -> IO ()
Vty.setMode Output
output Mode
Vty.Mouse forall a b. (a -> b) -> a -> b
$ Config -> Bool
configMouseMode Config
config
forall (m :: * -> *) a. Monad m => a -> m a
return Vty
vty
(ChatState
st, Vty
vty) <- IO Vty -> Maybe [Char] -> Config -> IO (ChatState, Vty)
setupState IO Vty
mkVty (Options -> Maybe [Char]
optLogLocation Options
opts) Config
config
ChatState
finalSt <- forall n e s.
Ord n =>
Vty -> IO Vty -> Maybe (BChan e) -> App s e n -> s -> IO s
customMain Vty
vty IO Vty
mkVty (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (BChan MHEvent)
crEventQueue) App ChatState MHEvent Name
app ChatState
st
case ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources (Maybe Aspell)
crSpellChecker of
Maybe Aspell
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just Aspell
s -> Aspell -> IO ()
stopAspell Aspell
s
forall (m :: * -> *) a. Monad m => a -> m a
return ChatState
finalSt
closeMatterhorn :: ChatState -> IO ()
closeMatterhorn :: ChatState -> IO ()
closeMatterhorn ChatState
finalSt = do
forall {a}. IO a -> [Char] -> IO ()
logIfError (Session -> IO ()
mmCloseSession forall a b. (a -> b) -> a -> b
$ ChatResources -> Session
getResourceSession forall a b. (a -> b) -> a -> b
$ ChatState
finalStforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResources)
[Char]
"Error in closing session"
forall {a}. IO a -> [Char] -> IO ()
logIfError (InputHistory -> IO ()
writeHistory (ChatState
finalStforall s a. s -> Getting a s a -> a
^.Lens' ChatState InputHistory
csInputHistory))
[Char]
"Error in writing history"
forall {a}. IO a -> [Char] -> IO ()
logIfError (ChatState -> IO ()
writeLastRunStates ChatState
finalSt)
[Char]
"Error in writing last run states"
LogManager -> IO ()
shutdownLogManager forall a b. (a -> b) -> a -> b
$ ChatState
finalStforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources LogManager
crLogManager
where
logIfError :: IO a -> [Char] -> IO ()
logIfError IO a
action [Char]
msg = do
Either [Char] a
done <- forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ forall a. IO a -> ExceptT [Char] IO a
convertIOException forall a b. (a -> b) -> a -> b
$ IO a
action
case Either [Char] a
done of
Left [Char]
err -> [Char] -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ [Char]
msg forall a. Semigroup a => a -> a -> a
<> [Char]
": " forall a. Semigroup a => a -> a -> a
<> [Char]
err
Right a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()