{-# LANGUAGE TypeFamilies #-}
module Matterhorn.State.Setup
( setupState
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick.BChan ( newBChan )
import Brick.Themes ( themeToAttrMap, loadCustomizations )
import qualified Control.Concurrent.STM as STM
import Data.Either ( fromRight )
import qualified Data.Foldable as F
import qualified Data.HashMap.Strict as HM
import Data.Maybe ( fromJust )
import qualified Data.Text as T
import Data.Time.Clock ( getCurrentTime )
import qualified Graphics.Vty as Vty
import Lens.Micro.Platform ( (.~) )
import System.Exit ( exitFailure, exitSuccess )
import System.FilePath ( (</>), isRelative, dropFileName )
import Network.Mattermost.Endpoints
import Network.Mattermost.Types
import Matterhorn.Config
import Matterhorn.InputHistory
import Matterhorn.Login
import Matterhorn.State.Flagging
import Matterhorn.State.Teams ( buildTeamState )
import Matterhorn.State.Setup.Threads
import Matterhorn.Themes
import Matterhorn.TimeUtils ( lookupLocalTimeZone, utcTimezone )
import Matterhorn.Types
import Matterhorn.Emoji
import Matterhorn.FilePaths ( userEmojiJsonPath, bundledEmojiJsonPath )
incompleteCredentials :: Config -> ConnectionInfo
incompleteCredentials :: Config -> ConnectionInfo
incompleteCredentials Config
config =
ConnectionInfo { _ciHostname :: Text
_ciHostname = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Config -> Maybe Text
configHost Config
config)
, _ciPort :: Int
_ciPort = Config -> Int
configPort Config
config
, _ciUrlPath :: Text
_ciUrlPath = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Config -> Maybe Text
configUrlPath Config
config)
, _ciUsername :: Text
_ciUsername = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" (Config -> Maybe Text
configUser Config
config)
, _ciPassword :: Text
_ciPassword = case Config -> Maybe PasswordSource
configPass Config
config of
Just (PasswordString Text
s) -> Text
s
Maybe PasswordSource
_ -> Text
""
, _ciOTPToken :: Maybe Text
_ciOTPToken = case Config -> Maybe OTPTokenSource
configOTPToken Config
config of
Just (OTPTokenString Text
s) -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
Maybe OTPTokenSource
_ -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""
, _ciAccessToken :: Text
_ciAccessToken = case Config -> Maybe TokenSource
configToken Config
config of
Just (TokenString Text
s) -> Text
s
Maybe TokenSource
_ -> Text
""
, _ciType :: ConnectionType
_ciType = Config -> ConnectionType
configConnectionType Config
config
}
apiLogEventToLogMessage :: LogEvent -> IO LogMessage
apiLogEventToLogMessage :: LogEvent -> IO LogMessage
apiLogEventToLogMessage LogEvent
ev = do
UTCTime
now <- IO UTCTime
getCurrentTime
let msg :: Text
msg = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"Function: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> LogEvent -> String
logFunction LogEvent
ev String -> String -> String
forall a. Semigroup a => a -> a -> a
<>
String
", event: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> LogEventType -> String
forall a. Show a => a -> String
show (LogEvent -> LogEventType
logEventType LogEvent
ev)
LogMessage -> IO LogMessage
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LogMessage -> IO LogMessage) -> LogMessage -> IO LogMessage
forall a b. (a -> b) -> a -> b
$ LogMessage { logMessageCategory :: LogCategory
logMessageCategory = LogCategory
LogAPI
, logMessageText :: Text
logMessageText = Text
msg
, logMessageContext :: Maybe LogContext
logMessageContext = Maybe LogContext
forall a. Maybe a
Nothing
, logMessageTimestamp :: UTCTime
logMessageTimestamp = UTCTime
now
}
setupState :: IO Vty.Vty -> Maybe FilePath -> Config -> IO (ChatState, Vty.Vty)
setupState :: IO Vty -> Maybe String -> Config -> IO (ChatState, Vty)
setupState IO Vty
mkVty Maybe String
mLogLocation Config
config = do
Vty
initialVty <- IO Vty
mkVty
BChan MHEvent
eventChan <- Int -> IO (BChan MHEvent)
forall a. Int -> IO (BChan a)
newBChan Int
2500
LogManager
logMgr <- BChan MHEvent -> Int -> IO LogManager
newLogManager BChan MHEvent
eventChan (Config -> Int
configLogMaxBufferSize Config
config)
case Maybe String
mLogLocation of
Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just String
loc -> LogManager -> String -> IO ()
startLoggingToFile LogManager
logMgr String
loc
let logApiEvent :: LogEvent -> IO ()
logApiEvent LogEvent
ev = LogEvent -> IO LogMessage
apiLogEventToLogMessage LogEvent
ev IO LogMessage -> (LogMessage -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogManager -> LogMessage -> IO ()
sendLogMessage LogManager
logMgr
setLogger :: ConnectionData -> ConnectionData
setLogger ConnectionData
cd = ConnectionData
cd ConnectionData -> (LogEvent -> IO ()) -> ConnectionData
`withLogger` LogEvent -> IO ()
logApiEvent
(Maybe LoginSuccess
mLoginSuccess, Vty
loginVty) <- Vty
-> IO Vty
-> (ConnectionData -> ConnectionData)
-> LogManager
-> ConnectionInfo
-> IO (Maybe LoginSuccess, Vty)
interactiveGetLoginSession Vty
initialVty IO Vty
mkVty
ConnectionData -> ConnectionData
setLogger
LogManager
logMgr
(Config -> ConnectionInfo
incompleteCredentials Config
config)
let shutdown :: Vty -> IO b
shutdown Vty
vty = do
Vty -> IO ()
Vty.shutdown Vty
vty
IO b
forall a. IO a
exitSuccess
(Session
session, User
me, ConnectionData
cd, Maybe Text
mbTeam) <- case Maybe LoginSuccess
mLoginSuccess of
Maybe LoginSuccess
Nothing ->
Vty -> IO (Session, User, ConnectionData, Maybe Text)
forall {b}. Vty -> IO b
shutdown Vty
loginVty
Just (LoginSuccess ConnectionData
cd Session
sess User
user Maybe Text
mbTeam) ->
(Session, User, ConnectionData, Maybe Text)
-> IO (Session, User, ConnectionData, Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Session
sess, User
user, ConnectionData
cd, Maybe Text
mbTeam)
[Team]
teams <- Seq Team -> [Team]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (Seq Team -> [Team]) -> IO (Seq Team) -> IO [Team]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UserParam -> Session -> IO (Seq Team)
mmGetUsersTeams UserParam
UserMe Session
session
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Team] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Team]
teams) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
putStrLn String
"Error: your account is not a member of any teams"
IO ()
forall a. IO a
exitFailure
let initialTeamId :: TeamId
initialTeamId = TeamId -> Maybe TeamId -> TeamId
forall a. a -> Maybe a -> a
fromMaybe (Team -> TeamId
teamId (Team -> TeamId) -> Team -> TeamId
forall a b. (a -> b) -> a -> b
$ [Team] -> Team
forall a. HasCallStack => [a] -> a
head [Team]
teams) (Maybe TeamId -> TeamId) -> Maybe TeamId -> TeamId
forall a b. (a -> b) -> a -> b
$ do
Text
tName <- Maybe Text
mbTeam Maybe Text -> Maybe Text -> Maybe Text
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> Maybe Text
configTeam Config
config
let matchingTeam :: Maybe Team
matchingTeam = [Team] -> Maybe Team
forall a. [a] -> Maybe a
listToMaybe ([Team] -> Maybe Team) -> [Team] -> Maybe Team
forall a b. (a -> b) -> a -> b
$ (Team -> Bool) -> [Team] -> [Team]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Team -> Bool
matchesTeam Text
tName) [Team]
teams
Team -> TeamId
teamId (Team -> TeamId) -> Maybe Team -> Maybe TeamId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Team
matchingTeam
TChan [UserId]
userStatusChan <- IO (TChan [UserId])
forall a. IO (TChan a)
STM.newTChanIO
TChan ProgramOutput
slc <- IO (TChan ProgramOutput)
forall a. IO (TChan a)
STM.newTChanIO
TChan WebsocketAction
wac <- IO (TChan WebsocketAction)
forall a. IO (TChan a)
STM.newTChanIO
Seq Preference
prefs <- UserParam -> Session -> IO (Seq Preference)
mmGetUsersPreferences UserParam
UserMe Session
session
let userPrefs :: UserPreferences
userPrefs = Seq Preference -> UserPreferences -> UserPreferences
setUserPreferences Seq Preference
prefs UserPreferences
defaultUserPreferences
themeName :: Text
themeName = case Config -> Maybe Text
configTheme Config
config of
Maybe Text
Nothing -> InternalTheme -> Text
internalThemeName InternalTheme
defaultTheme
Just Text
t -> Text
t
baseTheme :: Theme
baseTheme = InternalTheme -> Theme
internalTheme (InternalTheme -> Theme) -> InternalTheme -> Theme
forall a b. (a -> b) -> a -> b
$ InternalTheme -> Maybe InternalTheme -> InternalTheme
forall a. a -> Maybe a -> a
fromMaybe InternalTheme
defaultTheme (Text -> Maybe InternalTheme
lookupTheme Text
themeName)
Theme
custTheme <- case Config -> Maybe Text
configThemeCustomizationFile Config
config of
Maybe Text
Nothing -> Theme -> IO Theme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Theme
baseTheme
Just Text
path ->
let pathStr :: String
pathStr = Text -> String
T.unpack Text
path
in if String -> Bool
isRelative String
pathStr Bool -> Bool -> Bool
&& Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Config -> Maybe String
configAbsPath Config
config)
then Theme -> IO Theme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Theme
baseTheme
else do
let absPath :: String
absPath = if String -> Bool
isRelative String
pathStr
then (String -> String
dropFileName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Maybe String -> String
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ Config -> Maybe String
configAbsPath Config
config) String -> String -> String
</> String
pathStr
else String
pathStr
Either String Theme
result <- String -> Theme -> IO (Either String Theme)
loadCustomizations String
absPath Theme
baseTheme
case Either String Theme
result of
Left String
e -> do
Vty -> IO ()
Vty.shutdown Vty
loginVty
String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Error loading theme customization from " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> String
forall a. Show a => a -> String
show String
absPath String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e
IO Theme
forall a. IO a
exitFailure
Right Theme
t -> Theme -> IO Theme
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Theme
t
RequestChan
requestChan <- STM RequestChan -> IO RequestChan
forall a. STM a -> IO a
STM.atomically STM RequestChan
forall a. STM (TChan a)
STM.newTChan
EmojiCollection
emoji <- (String -> EmojiCollection)
-> (EmojiCollection -> EmojiCollection)
-> Either String EmojiCollection
-> EmojiCollection
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (EmojiCollection -> String -> EmojiCollection
forall a b. a -> b -> a
const EmojiCollection
emptyEmojiCollection) EmojiCollection -> EmojiCollection
forall a. a -> a
id (Either String EmojiCollection -> EmojiCollection)
-> IO (Either String EmojiCollection) -> IO EmojiCollection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Either String EmojiCollection
result1 <- String -> IO (Either String EmojiCollection)
loadEmoji (String -> IO (Either String EmojiCollection))
-> IO String -> IO (Either String EmojiCollection)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
userEmojiJsonPath
case Either String EmojiCollection
result1 of
Right EmojiCollection
e -> Either String EmojiCollection -> IO (Either String EmojiCollection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String EmojiCollection
-> IO (Either String EmojiCollection))
-> Either String EmojiCollection
-> IO (Either String EmojiCollection)
forall a b. (a -> b) -> a -> b
$ EmojiCollection -> Either String EmojiCollection
forall a b. b -> Either a b
Right EmojiCollection
e
Left String
_ -> String -> IO (Either String EmojiCollection)
loadEmoji (String -> IO (Either String EmojiCollection))
-> IO String -> IO (Either String EmojiCollection)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
bundledEmojiJsonPath
Maybe Aspell
spResult <- Config -> IO (Maybe Aspell)
maybeStartSpellChecker Config
config
let cr :: ChatResources
cr = ChatResources { _crSession :: Session
_crSession = Session
session
, _crWebsocketThreadId :: Maybe ThreadId
_crWebsocketThreadId = Maybe ThreadId
forall a. Maybe a
Nothing
, _crConn :: ConnectionData
_crConn = ConnectionData
cd
, _crRequestQueue :: RequestChan
_crRequestQueue = RequestChan
requestChan
, _crEventQueue :: BChan MHEvent
_crEventQueue = BChan MHEvent
eventChan
, _crSubprocessLog :: TChan ProgramOutput
_crSubprocessLog = TChan ProgramOutput
slc
, _crWebsocketActionChan :: TChan WebsocketAction
_crWebsocketActionChan = TChan WebsocketAction
wac
, _crTheme :: AttrMap
_crTheme = Theme -> AttrMap
themeToAttrMap Theme
custTheme
, _crThemeOriginal :: Theme
_crThemeOriginal = Theme
custTheme
, _crStatusUpdateChan :: TChan [UserId]
_crStatusUpdateChan = TChan [UserId]
userStatusChan
, _crConfiguration :: Config
_crConfiguration = Config
config
, _crFlaggedPosts :: Set PostId
_crFlaggedPosts = Set PostId
forall a. Monoid a => a
mempty
, _crUserPreferences :: UserPreferences
_crUserPreferences = UserPreferences
userPrefs
, _crSyntaxMap :: SyntaxMap
_crSyntaxMap = SyntaxMap
forall a. Monoid a => a
mempty
, _crLogManager :: LogManager
_crLogManager = LogManager
logMgr
, _crEmoji :: EmojiCollection
_crEmoji = EmojiCollection
emoji
, _crSpellChecker :: Maybe Aspell
_crSpellChecker = Maybe Aspell
spResult
, _crWindowSize :: (Int, Int)
_crWindowSize = (Int
0, Int
0)
}
ChatState
st <- ChatResources -> TeamId -> [Team] -> User -> IO ChatState
initializeState ChatResources
cr TeamId
initialTeamId [Team]
teams User
me
(ChatState, Vty) -> IO (ChatState, Vty)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ChatState
st, Vty
loginVty)
initializeState :: ChatResources -> TeamId -> [Team] -> User -> IO ChatState
initializeState :: ChatResources -> TeamId -> [Team] -> User -> IO ChatState
initializeState ChatResources
cr TeamId
initialTeamId [Team]
teams User
me = do
let session :: Session
session = ChatResources -> Session
getResourceSession ChatResources
cr
requestChan :: RequestChan
requestChan = ChatResources
crChatResources
-> Getting RequestChan ChatResources RequestChan -> RequestChan
forall s a. s -> Getting a s a -> a
^.Getting RequestChan ChatResources RequestChan
Lens' ChatResources RequestChan
crRequestQueue
TimeZoneSeries
tz <- TimeZoneSeries
-> Either SomeException TimeZoneSeries -> TimeZoneSeries
forall b a. b -> Either a b -> b
fromRight TimeZoneSeries
utcTimezone (Either SomeException TimeZoneSeries -> TimeZoneSeries)
-> IO (Either SomeException TimeZoneSeries) -> IO TimeZoneSeries
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Either SomeException TimeZoneSeries)
lookupLocalTimeZone
InputHistory
hist <- do
Either String InputHistory
result <- IO (Either String InputHistory)
readHistory
case Either String InputHistory
result of
Left String
_ -> InputHistory -> IO InputHistory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputHistory
newHistory
Right InputHistory
h -> InputHistory -> IO InputHistory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InputHistory
h
Config -> BChan MHEvent -> IO ()
startSyntaxMapLoaderThread (ChatResources
crChatResources -> Getting Config ChatResources Config -> Config
forall s a. s -> Getting a s a -> a
^.Getting Config ChatResources Config
Lens' ChatResources Config
crConfiguration) (ChatResources
crChatResources
-> Getting (BChan MHEvent) ChatResources (BChan MHEvent)
-> BChan MHEvent
forall s a. s -> Getting a s a -> a
^.Getting (BChan MHEvent) ChatResources (BChan MHEvent)
Lens' ChatResources (BChan MHEvent)
crEventQueue)
Config -> RequestChan -> BChan MHEvent -> IO ()
startAsyncWorkerThread (ChatResources
crChatResources -> Getting Config ChatResources Config -> Config
forall s a. s -> Getting a s a -> a
^.Getting Config ChatResources Config
Lens' ChatResources Config
crConfiguration) (ChatResources
crChatResources
-> Getting RequestChan ChatResources RequestChan -> RequestChan
forall s a. s -> Getting a s a -> a
^.Getting RequestChan ChatResources RequestChan
Lens' ChatResources RequestChan
crRequestQueue) (ChatResources
crChatResources
-> Getting (BChan MHEvent) ChatResources (BChan MHEvent)
-> BChan MHEvent
forall s a. s -> Getting a s a -> a
^.Getting (BChan MHEvent) ChatResources (BChan MHEvent)
Lens' ChatResources (BChan MHEvent)
crEventQueue)
TChan [UserId] -> Session -> RequestChan -> IO ()
startUserStatusUpdateThread (ChatResources
crChatResources
-> Getting (TChan [UserId]) ChatResources (TChan [UserId])
-> TChan [UserId]
forall s a. s -> Getting a s a -> a
^.Getting (TChan [UserId]) ChatResources (TChan [UserId])
Lens' ChatResources (TChan [UserId])
crStatusUpdateChan) Session
session RequestChan
requestChan
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configShowTypingIndicator (ChatResources
crChatResources -> Getting Config ChatResources Config -> Config
forall s a. s -> Getting a s a -> a
^.Getting Config ChatResources Config
Lens' ChatResources Config
crConfiguration)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
RequestChan -> IO ()
startTypingUsersRefreshThread RequestChan
requestChan
TimeZoneSeries -> RequestChan -> IO ()
startTimezoneMonitorThread TimeZoneSeries
tz RequestChan
requestChan
TChan ProgramOutput -> RequestChan -> IO ()
startSubprocessLoggerThread (ChatResources
crChatResources
-> Getting
(TChan ProgramOutput) ChatResources (TChan ProgramOutput)
-> TChan ProgramOutput
forall s a. s -> Getting a s a -> a
^.Getting (TChan ProgramOutput) ChatResources (TChan ProgramOutput)
Lens' ChatResources (TChan ProgramOutput)
crSubprocessLog) RequestChan
requestChan
([TeamState]
teamStates, [ClientChannels]
chanLists) <- [(TeamState, ClientChannels)] -> ([TeamState], [ClientChannels])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TeamState, ClientChannels)] -> ([TeamState], [ClientChannels]))
-> IO [(TeamState, ClientChannels)]
-> IO ([TeamState], [ClientChannels])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Team -> IO (TeamState, ClientChannels))
-> [Team] -> IO [(TeamState, ClientChannels)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (ChatResources -> User -> Team -> IO (TeamState, ClientChannels)
buildTeamState ChatResources
cr User
me) [Team]
teams
let startupState :: StartupStateInfo
startupState =
StartupStateInfo { startupStateResources :: ChatResources
startupStateResources = ChatResources
cr
, startupStateConnectedUser :: User
startupStateConnectedUser = User
me
, startupStateTimeZone :: TimeZoneSeries
startupStateTimeZone = TimeZoneSeries
tz
, startupStateInitialHistory :: InputHistory
startupStateInitialHistory = InputHistory
hist
, startupStateInitialTeam :: TeamId
startupStateInitialTeam = TeamId
initialTeamId
, startupStateTeams :: HashMap TeamId TeamState
startupStateTeams = HashMap TeamId TeamState
teamMap
}
clientChans :: ClientChannels
clientChans = [ClientChannels] -> ClientChannels
forall a. Monoid a => [a] -> a
mconcat [ClientChannels]
chanLists
st :: ChatState
st = StartupStateInfo -> ChatState
newState StartupStateInfo
startupState ChatState -> (ChatState -> ChatState) -> ChatState
forall a b. a -> (a -> b) -> b
& (ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState
Lens' ChatState ClientChannels
csChannels ((ClientChannels -> Identity ClientChannels)
-> ChatState -> Identity ChatState)
-> ClientChannels -> ChatState -> ChatState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ClientChannels
clientChans
teamMap :: HashMap TeamId TeamState
teamMap = [(TeamId, TeamState)] -> HashMap TeamId TeamState
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(TeamId, TeamState)] -> HashMap TeamId TeamState)
-> [(TeamId, TeamState)] -> HashMap TeamId TeamState
forall a b. (a -> b) -> a -> b
$ (\TeamState
ts -> (Team -> TeamId
teamId (Team -> TeamId) -> Team -> TeamId
forall a b. (a -> b) -> a -> b
$ TeamState -> Team
_tsTeam TeamState
ts, TeamState
ts)) (TeamState -> (TeamId, TeamState))
-> [TeamState] -> [(TeamId, TeamState)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TeamState] -> [TeamState]
forall a. [a] -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList [TeamState]
teamStates
Seq FlaggedPost -> ChatState -> IO ()
loadFlaggedMessages (ChatResources
crChatResources
-> Getting (Seq FlaggedPost) ChatResources (Seq FlaggedPost)
-> Seq FlaggedPost
forall s a. s -> Getting a s a -> a
^.(UserPreferences -> Const (Seq FlaggedPost) UserPreferences)
-> ChatResources -> Const (Seq FlaggedPost) ChatResources
Lens' ChatResources UserPreferences
crUserPreferences((UserPreferences -> Const (Seq FlaggedPost) UserPreferences)
-> ChatResources -> Const (Seq FlaggedPost) ChatResources)
-> ((Seq FlaggedPost -> Const (Seq FlaggedPost) (Seq FlaggedPost))
-> UserPreferences -> Const (Seq FlaggedPost) UserPreferences)
-> Getting (Seq FlaggedPost) ChatResources (Seq FlaggedPost)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Seq FlaggedPost -> Const (Seq FlaggedPost) (Seq FlaggedPost))
-> UserPreferences -> Const (Seq FlaggedPost) UserPreferences
Lens' UserPreferences (Seq FlaggedPost)
userPrefFlaggedPostList) ChatState
st
BChan MHEvent -> MHEvent -> IO ()
forall (m :: * -> *). MonadIO m => BChan MHEvent -> MHEvent -> m ()
writeBChan (ChatResources
crChatResources
-> Getting (BChan MHEvent) ChatResources (BChan MHEvent)
-> BChan MHEvent
forall s a. s -> Getting a s a -> a
^.Getting (BChan MHEvent) ChatResources (BChan MHEvent)
Lens' ChatResources (BChan MHEvent)
crEventQueue) MHEvent
RefreshWebsocketEvent
ChatState -> IO ChatState
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ChatState
st