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 qualified Graphics.Vty.CrossPlatform as Vty
import           Text.Aspell ( stopAspell )
import           GHC.Conc (getNumProcessors, setNumCapabilities)

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
        , appAttrMap :: ChatState -> AttrMap
appAttrMap      = (ChatState -> Getting AttrMap ChatState AttrMap -> AttrMap
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const AttrMap ChatResources)
-> ChatState -> Const AttrMap ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const AttrMap ChatResources)
 -> ChatState -> Const AttrMap ChatState)
-> ((AttrMap -> Const AttrMap AttrMap)
    -> ChatResources -> Const AttrMap ChatResources)
-> Getting AttrMap ChatState AttrMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AttrMap -> Const AttrMap AttrMap)
-> ChatResources -> Const AttrMap ChatResources
Lens' ChatResources AttrMap
crTheme)
        , appChooseCursor :: ChatState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
appChooseCursor = \ChatState
s [CursorLocation Name]
cs -> do
            TeamId
tId <- ChatState
sChatState
-> Getting (Maybe TeamId) ChatState (Maybe TeamId) -> Maybe TeamId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe TeamId) ChatState (Maybe TeamId)
SimpleGetter ChatState (Maybe TeamId)
csCurrentTeamId
            [CursorLocation Name]
-> ChatState -> TeamId -> Mode -> Maybe (CursorLocation Name)
cursorByMode [CursorLocation Name]
cs ChatState
s TeamId
tId (TeamState -> Mode
teamMode (TeamState -> Mode) -> TeamState -> Mode
forall a b. (a -> b) -> a -> b
$ ChatState
sChatState -> Getting TeamState ChatState TeamState -> TeamState
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId))
        , appStartEvent :: EventM Name ChatState ()
appStartEvent = do
            Vty
vty <- EventM Name ChatState Vty
forall n s. EventM n s Vty
getVtyHandle
            (Int
w, Int
h) <- IO (Int, Int) -> EventM Name ChatState (Int, Int)
forall a. IO a -> EventM Name ChatState a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int) -> EventM Name ChatState (Int, Int))
-> IO (Int, Int) -> EventM Name ChatState (Int, Int)
forall a b. (a -> b) -> a -> b
$ Output -> IO (Int, Int)
Vty.displayBounds (Output -> IO (Int, Int)) -> Output -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ Vty -> Output
Vty.outputIface Vty
vty
            MH () -> EventM Name ChatState ()
runMHEvent (MH () -> EventM Name ChatState ())
-> MH () -> EventM Name ChatState ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MH ()
Events.setWindowSize Int
w Int
h
        }

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
sChatState
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
-> MessageInterfaceFocus
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const MessageInterfaceFocus TeamState)
 -> ChatState -> Const MessageInterfaceFocus ChatState)
-> ((MessageInterfaceFocus
     -> Const MessageInterfaceFocus MessageInterfaceFocus)
    -> TeamState -> Const MessageInterfaceFocus TeamState)
-> Getting MessageInterfaceFocus ChatState MessageInterfaceFocus
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(MessageInterfaceFocus
 -> Const MessageInterfaceFocus MessageInterfaceFocus)
-> TeamState -> Const MessageInterfaceFocus TeamState
Lens' TeamState MessageInterfaceFocus
tsMessageInterfaceFocus of
            MessageInterfaceFocus
FocusCurrentChannel -> do
                ChannelId
cId <- ChatState
sChatState
-> Getting (Maybe ChannelId) ChatState (Maybe ChannelId)
-> Maybe ChannelId
forall s a. s -> Getting a s a -> a
^.TeamId -> SimpleGetter ChatState (Maybe ChannelId)
csCurrentChannelId(TeamId
tId)
                ChannelMessageInterface
mi <- ChatState
sChatState
-> Getting
     (First ChannelMessageInterface) ChatState ChannelMessageInterface
-> Maybe ChannelMessageInterface
forall s a. s -> Getting (First a) s a -> Maybe a
^?ChannelId -> Traversal' ChatState ChannelMessageInterface
maybeChannelMessageInterface(ChannelId
cId)
                Name
cur <- ChannelMessageInterface -> Maybe Name
forall n i. MessageInterface n i -> Maybe n
messageInterfaceCursor ChannelMessageInterface
mi
                Name -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed Name
cur [CursorLocation Name]
cs
            MessageInterfaceFocus
FocusThread -> do
                ThreadInterface
ti <- ChatState
sChatState
-> Getting
     (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
-> Maybe ThreadInterface
forall s a. s -> Getting a s a -> a
^.TeamId -> Lens' ChatState TeamState
csTeam(TeamId
tId)((TeamState -> Const (Maybe ThreadInterface) TeamState)
 -> ChatState -> Const (Maybe ThreadInterface) ChatState)
-> ((Maybe ThreadInterface
     -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
    -> TeamState -> Const (Maybe ThreadInterface) TeamState)
-> Getting
     (Maybe ThreadInterface) ChatState (Maybe ThreadInterface)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe ThreadInterface
 -> Const (Maybe ThreadInterface) (Maybe ThreadInterface))
-> TeamState -> Const (Maybe ThreadInterface) TeamState
Lens' TeamState (Maybe ThreadInterface)
tsThreadInterface
                Name
cur <- ThreadInterface -> Maybe Name
forall n i. MessageInterface n i -> Maybe n
messageInterfaceCursor ThreadInterface
ti
                Name -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall n.
Eq n =>
n -> [CursorLocation n] -> Maybe (CursorLocation n)
showCursorNamed Name
cur [CursorLocation Name]
cs
        Mode
LeaveChannelConfirm           -> Maybe (CursorLocation Name)
forall a. Maybe a
Nothing
        Mode
DeleteChannelConfirm          -> Maybe (CursorLocation Name)
forall a. Maybe a
Nothing
        MessageSelectDeleteConfirm {} -> Maybe (CursorLocation Name)
forall a. Maybe a
Nothing
        (PostListWindow {})           -> Maybe (CursorLocation Name)
forall a. Maybe a
Nothing
        Mode
ViewMessage                   -> Maybe (CursorLocation Name)
forall a. Maybe a
Nothing
        (ShowHelp {})                 -> Maybe (CursorLocation Name)
forall a. Maybe a
Nothing
        Mode
EditNotifyPrefs               -> Maybe (CursorLocation Name)
forall a. Maybe a
Nothing
        Mode
ChannelSelect                 -> ChatState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
        Mode
UserListWindow                -> ChatState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
        Mode
ReactionEmojiListWindow       -> ChatState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
        Mode
ChannelListWindow             -> ChatState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
        Mode
ThemeListWindow               -> ChatState -> [CursorLocation Name] -> Maybe (CursorLocation Name)
forall s n. s -> [CursorLocation n] -> Maybe (CursorLocation n)
showFirstCursor ChatState
s [CursorLocation Name]
cs
        Mode
ChannelTopicWindow            -> Name -> [CursorLocation Name] -> Maybe (CursorLocation Name)
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 -> Int -> Int -> Int
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
          Vty
vty <- VtyUserConfig -> IO Vty
Vty.mkVty VtyUserConfig
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 (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Bool
configHyperlinkingMode Config
config
          Output -> Mode -> Bool -> IO ()
Vty.setMode Output
output Mode
Vty.Mouse (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Config -> Bool
configMouseMode Config
config
          Vty -> IO Vty
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Vty
vty

    (ChatState
st, Vty
vty) <- IO Vty -> Maybe FilePath -> Config -> IO (ChatState, Vty)
setupState IO Vty
mkVty (Options -> Maybe FilePath
optLogLocation Options
opts) Config
config
    ChatState
finalSt <- Vty
-> IO Vty
-> Maybe (BChan MHEvent)
-> App ChatState MHEvent Name
-> ChatState
-> IO ChatState
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 (BChan MHEvent -> Maybe (BChan MHEvent)
forall a. a -> Maybe a
Just (BChan MHEvent -> Maybe (BChan MHEvent))
-> BChan MHEvent -> Maybe (BChan MHEvent)
forall a b. (a -> b) -> a -> b
$ ChatState
stChatState
-> Getting (BChan MHEvent) ChatState (BChan MHEvent)
-> BChan MHEvent
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (BChan MHEvent) ChatResources)
-> ChatState -> Const (BChan MHEvent) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (BChan MHEvent) ChatResources)
 -> ChatState -> Const (BChan MHEvent) ChatState)
-> ((BChan MHEvent -> Const (BChan MHEvent) (BChan MHEvent))
    -> ChatResources -> Const (BChan MHEvent) ChatResources)
-> Getting (BChan MHEvent) ChatState (BChan MHEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(BChan MHEvent -> Const (BChan MHEvent) (BChan MHEvent))
-> ChatResources -> Const (BChan MHEvent) ChatResources
Lens' ChatResources (BChan MHEvent)
crEventQueue) App ChatState MHEvent Name
app ChatState
st

    case ChatState
stChatState
-> Getting (Maybe Aspell) ChatState (Maybe Aspell) -> Maybe Aspell
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (Maybe Aspell) ChatResources)
-> ChatState -> Const (Maybe Aspell) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Aspell) ChatResources)
 -> ChatState -> Const (Maybe Aspell) ChatState)
-> ((Maybe Aspell -> Const (Maybe Aspell) (Maybe Aspell))
    -> ChatResources -> Const (Maybe Aspell) ChatResources)
-> Getting (Maybe Aspell) ChatState (Maybe Aspell)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Aspell -> Const (Maybe Aspell) (Maybe Aspell))
-> ChatResources -> Const (Maybe Aspell) ChatResources
Lens' ChatResources (Maybe Aspell)
crSpellChecker of
        Maybe Aspell
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Aspell
s -> Aspell -> IO ()
stopAspell Aspell
s

    ChatState -> IO ChatState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatState
finalSt

-- | Cleanup resources and save data for restoring on program restart.
closeMatterhorn :: ChatState -> IO ()
closeMatterhorn :: ChatState -> IO ()
closeMatterhorn ChatState
finalSt = do
  IO () -> FilePath -> IO ()
forall {a}. IO a -> FilePath -> IO ()
logIfError (Session -> IO ()
mmCloseSession (Session -> IO ()) -> Session -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatResources -> Session
getResourceSession (ChatResources -> Session) -> ChatResources -> Session
forall a b. (a -> b) -> a -> b
$ ChatState
finalStChatState
-> Getting ChatResources ChatState ChatResources -> ChatResources
forall s a. s -> Getting a s a -> a
^.Getting ChatResources ChatState ChatResources
Lens' ChatState ChatResources
csResources)
      FilePath
"Error in closing session"

  IO () -> FilePath -> IO ()
forall {a}. IO a -> FilePath -> IO ()
logIfError (InputHistory -> IO ()
writeHistory (ChatState
finalStChatState
-> Getting InputHistory ChatState InputHistory -> InputHistory
forall s a. s -> Getting a s a -> a
^.Getting InputHistory ChatState InputHistory
Lens' ChatState InputHistory
csInputHistory))
      FilePath
"Error in writing history"

  IO () -> FilePath -> IO ()
forall {a}. IO a -> FilePath -> IO ()
logIfError (ChatState -> IO ()
writeLastRunStates ChatState
finalSt)
      FilePath
"Error in writing last run states"

  LogManager -> IO ()
shutdownLogManager (LogManager -> IO ()) -> LogManager -> IO ()
forall a b. (a -> b) -> a -> b
$ ChatState
finalStChatState -> Getting LogManager ChatState LogManager -> LogManager
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const LogManager ChatResources)
-> ChatState -> Const LogManager ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const LogManager ChatResources)
 -> ChatState -> Const LogManager ChatState)
-> ((LogManager -> Const LogManager LogManager)
    -> ChatResources -> Const LogManager ChatResources)
-> Getting LogManager ChatState LogManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(LogManager -> Const LogManager LogManager)
-> ChatResources -> Const LogManager ChatResources
Lens' ChatResources LogManager
crLogManager

  where
    logIfError :: IO a -> FilePath -> IO ()
logIfError IO a
action FilePath
msg = do
      Either FilePath a
done <- ExceptT FilePath IO a -> IO (Either FilePath a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT FilePath IO a -> IO (Either FilePath a))
-> ExceptT FilePath IO a -> IO (Either FilePath a)
forall a b. (a -> b) -> a -> b
$ IO a -> ExceptT FilePath IO a
forall a. IO a -> ExceptT FilePath IO a
convertIOException (IO a -> ExceptT FilePath IO a) -> IO a -> ExceptT FilePath IO a
forall a b. (a -> b) -> a -> b
$ IO a
action
      case Either FilePath a
done of
        Left FilePath
err -> FilePath -> IO ()
putStrLn (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
msg FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
": " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
err
        Right a
_  -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()