module Matterhorn.Draw.Util
( withBrackets
, renderTime
, renderDate
, renderKeybindingHelp
, insertDateMarkers
, getDateFormat
, mkChannelName
, userSigilFromInfo
, multilineHeightLimit
, keyEventBindings
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Data.List ( intersperse )
import qualified Data.Map as M
import qualified Data.Set as Set
import qualified Data.Text as T
import Network.Mattermost.Types
import Matterhorn.Constants ( userSigil, normalChannelSigil )
import Matterhorn.Themes
import Matterhorn.TimeUtils
import Matterhorn.Types
import Matterhorn.Types.KeyEvents
import Matterhorn.Events.Keybindings
defaultTimeFormat :: Text
defaultTimeFormat :: Text
defaultTimeFormat = Text
"%R"
defaultDateFormat :: Text
defaultDateFormat :: Text
defaultDateFormat = Text
"%Y-%m-%d"
multilineHeightLimit :: Int
multilineHeightLimit :: Int
multilineHeightLimit = Int
5
getTimeFormat :: ChatState -> Text
getTimeFormat :: ChatState -> Text
getTimeFormat ChatState
st =
Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
defaultTimeFormat Text -> Text
forall a. a -> a
id (ChatState
stChatState
-> Getting (Maybe Text) ChatState (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources -> Const (Maybe Text) ChatResources)
-> Getting (Maybe Text) ChatState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources
-> Const (Maybe Text) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config
Lens' Config (Maybe Text)
configTimeFormatL)
getDateFormat :: ChatState -> Text
getDateFormat :: ChatState -> Text
getDateFormat ChatState
st =
Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
defaultDateFormat Text -> Text
forall a. a -> a
id (ChatState
stChatState
-> Getting (Maybe Text) ChatState (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (Maybe Text) ChatResources)
-> ChatState -> Const (Maybe Text) ChatState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources -> Const (Maybe Text) ChatResources)
-> Getting (Maybe Text) ChatState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (Maybe Text) Config)
-> ChatResources -> Const (Maybe Text) ChatResources)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> ChatResources
-> Const (Maybe Text) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Maybe Text -> Const (Maybe Text) (Maybe Text))
-> Config -> Const (Maybe Text) Config
Lens' Config (Maybe Text)
configDateFormatL)
renderTime :: ChatState -> UTCTime -> Widget Name
renderTime :: ChatState -> UTCTime -> Widget Name
renderTime ChatState
st = Text -> TimeZoneSeries -> UTCTime -> Widget Name
forall a. Text -> TimeZoneSeries -> UTCTime -> Widget a
renderUTCTime (ChatState -> Text
getTimeFormat ChatState
st) (ChatState
stChatState
-> Getting TimeZoneSeries ChatState TimeZoneSeries
-> TimeZoneSeries
forall s a. s -> Getting a s a -> a
^.Getting TimeZoneSeries ChatState TimeZoneSeries
Lens' ChatState TimeZoneSeries
timeZone)
renderDate :: ChatState -> UTCTime -> Widget Name
renderDate :: ChatState -> UTCTime -> Widget Name
renderDate ChatState
st = Text -> TimeZoneSeries -> UTCTime -> Widget Name
forall a. Text -> TimeZoneSeries -> UTCTime -> Widget a
renderUTCTime (ChatState -> Text
getDateFormat ChatState
st) (ChatState
stChatState
-> Getting TimeZoneSeries ChatState TimeZoneSeries
-> TimeZoneSeries
forall s a. s -> Getting a s a -> a
^.Getting TimeZoneSeries ChatState TimeZoneSeries
Lens' ChatState TimeZoneSeries
timeZone)
renderUTCTime :: Text -> TimeZoneSeries -> UTCTime -> Widget a
renderUTCTime :: Text -> TimeZoneSeries -> UTCTime -> Widget a
renderUTCTime Text
fmt TimeZoneSeries
tz UTCTime
t =
if Text -> Bool
T.null Text
fmt
then Widget a
forall n. Widget n
emptyWidget
else AttrName -> Widget a -> Widget a
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
timeAttr (Text -> Widget a
forall n. Text -> Widget n
txt (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text -> LocalTime -> Text
localTimeText Text
fmt (LocalTime -> Text) -> LocalTime -> Text
forall a b. (a -> b) -> a -> b
$ TimeZoneSeries -> UTCTime -> LocalTime
asLocalTime TimeZoneSeries
tz UTCTime
t)
renderKeybindingHelp :: ChatState -> Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp :: ChatState -> Text -> [KeyEvent] -> Widget Name
renderKeybindingHelp ChatState
st Text
label [KeyEvent]
evs =
let ppEv :: KeyEvent -> Widget n
ppEv KeyEvent
ev = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$ Text -> Widget n
forall n. Text -> Widget n
txt (Binding -> Text
ppBinding (KeyConfig -> KeyEvent -> Binding
firstActiveBinding KeyConfig
kc KeyEvent
ev))
kc :: KeyConfig
kc = ChatState
stChatState -> Getting KeyConfig ChatState KeyConfig -> KeyConfig
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const KeyConfig ChatResources)
-> ChatState -> Const KeyConfig ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const KeyConfig ChatResources)
-> ChatState -> Const KeyConfig ChatState)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
-> ChatResources -> Const KeyConfig ChatResources)
-> Getting KeyConfig ChatState KeyConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const KeyConfig Config)
-> ChatResources -> Const KeyConfig ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const KeyConfig Config)
-> ChatResources -> Const KeyConfig ChatResources)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
-> Config -> Const KeyConfig Config)
-> (KeyConfig -> Const KeyConfig KeyConfig)
-> ChatResources
-> Const KeyConfig ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeyConfig -> Const KeyConfig KeyConfig)
-> Config -> Const KeyConfig Config
Lens' Config KeyConfig
configUserKeysL
in [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox ([Widget Name] -> Widget Name) -> [Widget Name] -> Widget Name
forall a b. (a -> b) -> a -> b
$ (Widget Name -> [Widget Name] -> [Widget Name]
forall a. a -> [a] -> [a]
intersperse (Text -> Widget Name
forall n. Text -> Widget n
txt Text
"/") ([Widget Name] -> [Widget Name]) -> [Widget Name] -> [Widget Name]
forall a b. (a -> b) -> a -> b
$ KeyEvent -> Widget Name
forall n. KeyEvent -> Widget n
ppEv (KeyEvent -> Widget Name) -> [KeyEvent] -> [Widget Name]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEvent]
evs) [Widget Name] -> [Widget Name] -> [Widget Name]
forall a. Semigroup a => a -> a -> a
<> [Text -> Widget Name
forall n. Text -> Widget n
txt (Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label)]
insertDateMarkers :: Messages -> Text -> TimeZoneSeries -> Messages
insertDateMarkers :: Messages -> Text -> TimeZoneSeries -> Messages
insertDateMarkers Messages
ms Text
datefmt TimeZoneSeries
tz = (UTCTime -> Messages -> Messages)
-> Messages -> Set UTCTime -> Messages
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Message -> Messages -> Messages
forall a. MessageOps a => Message -> a -> a
addMessage (Message -> Messages -> Messages)
-> (UTCTime -> Message) -> UTCTime -> Messages -> Messages
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Message
dateMsg) Messages
ms Set UTCTime
dateRange
where dateRange :: Set UTCTime
dateRange = (Message -> Set UTCTime -> Set UTCTime)
-> Set UTCTime -> Messages -> Set UTCTime
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message -> Set UTCTime -> Set UTCTime
checkDateChange Set UTCTime
forall a. Set a
Set.empty Messages
ms
checkDateChange :: Message -> Set UTCTime -> Set UTCTime
checkDateChange Message
m = let msgDay :: UTCTime
msgDay = Maybe TimeZoneSeries -> UTCTime -> UTCTime
startOfDay (TimeZoneSeries -> Maybe TimeZoneSeries
forall a. a -> Maybe a
Just TimeZoneSeries
tz) (ServerTime -> UTCTime
withServerTime (Message
mMessage -> Getting ServerTime Message ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.Getting ServerTime Message ServerTime
Lens' Message ServerTime
mDate))
in if Message
mMessage -> Getting Bool Message Bool -> Bool
forall s a. s -> Getting a s a -> a
^.Getting Bool Message Bool
Lens' Message Bool
mDeleted then Set UTCTime -> Set UTCTime
forall a. a -> a
id else UTCTime -> Set UTCTime -> Set UTCTime
forall a. Ord a => a -> Set a -> Set a
Set.insert UTCTime
msgDay
dateMsg :: UTCTime -> Message
dateMsg UTCTime
d = let t :: Text
t = Text -> LocalTime -> Text
localTimeText Text
datefmt (LocalTime -> Text) -> LocalTime -> Text
forall a b. (a -> b) -> a -> b
$ TimeZoneSeries -> UTCTime -> LocalTime
asLocalTime TimeZoneSeries
tz UTCTime
d
in Text -> MessageType -> ServerTime -> Message
newMessageOfType Text
t (ClientMessageType -> MessageType
C ClientMessageType
DateTransition) (UTCTime -> ServerTime
ServerTime UTCTime
d)
withBrackets :: Widget a -> Widget a
withBrackets :: Widget a -> Widget a
withBrackets Widget a
w = [Widget a] -> Widget a
forall n. [Widget n] -> Widget n
hBox [String -> Widget a
forall n. String -> Widget n
str String
"[", Widget a
w, String -> Widget a
forall n. String -> Widget n
str String
"]"]
userSigilFromInfo :: UserInfo -> Char
userSigilFromInfo :: UserInfo -> Char
userSigilFromInfo UserInfo
u = case UserInfo
uUserInfo -> Getting UserStatus UserInfo UserStatus -> UserStatus
forall s a. s -> Getting a s a -> a
^.Getting UserStatus UserInfo UserStatus
Lens' UserInfo UserStatus
uiStatus of
UserStatus
Offline -> Char
' '
UserStatus
Online -> Char
'+'
UserStatus
Away -> Char
'-'
UserStatus
DoNotDisturb -> Char
'×'
Other Text
_ -> Char
'?'
mkChannelName :: ChatState -> ChannelInfo -> Text
mkChannelName :: ChatState -> ChannelInfo -> Text
mkChannelName ChatState
st ChannelInfo
c = Text -> Text -> Text
T.append Text
sigil Text
t
where
t :: Text
t = case ChannelInfo
cChannelInfo
-> Getting (Maybe UserId) ChannelInfo (Maybe UserId)
-> Maybe UserId
forall s a. s -> Getting a s a -> a
^.Getting (Maybe UserId) ChannelInfo (Maybe UserId)
Lens' ChannelInfo (Maybe UserId)
cdDMUserId Maybe UserId -> (UserId -> Maybe UserInfo) -> Maybe UserInfo
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (UserId -> ChatState -> Maybe UserInfo)
-> ChatState -> UserId -> Maybe UserInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> ChatState -> Maybe UserInfo
userById ChatState
st of
Maybe UserInfo
Nothing -> ChannelInfo
cChannelInfo -> Getting Text ChannelInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text ChannelInfo Text
Lens' ChannelInfo Text
cdName
Just UserInfo
u -> UserInfo
uUserInfo -> Getting Text UserInfo Text -> Text
forall s a. s -> Getting a s a -> a
^.Getting Text UserInfo Text
Lens' UserInfo Text
uiName
sigil :: Text
sigil = case ChannelInfo
cChannelInfo -> Getting Type ChannelInfo Type -> Type
forall s a. s -> Getting a s a -> a
^.Getting Type ChannelInfo Type
Lens' ChannelInfo Type
cdType of
Type
Private -> Text
forall a. Monoid a => a
mempty
Type
Ordinary -> Text
normalChannelSigil
Type
Group -> Text
forall a. Monoid a => a
mempty
Type
Direct -> Text
userSigil
Unknown Text
_ -> Text
forall a. Monoid a => a
mempty
keyEventBindings :: ChatState
-> (KeyConfig -> KeyHandlerMap)
-> KeyEvent
-> T.Text
keyEventBindings :: ChatState -> (KeyConfig -> KeyHandlerMap) -> KeyEvent -> Text
keyEventBindings ChatState
st KeyConfig -> KeyHandlerMap
mkBindingsMap KeyEvent
e =
let keyconf :: KeyConfig
keyconf = ChatState
stChatState -> Getting KeyConfig ChatState KeyConfig -> KeyConfig
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const KeyConfig ChatResources)
-> ChatState -> Const KeyConfig ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const KeyConfig ChatResources)
-> ChatState -> Const KeyConfig ChatState)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
-> ChatResources -> Const KeyConfig ChatResources)
-> Getting KeyConfig ChatState KeyConfig
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const KeyConfig Config)
-> ChatResources -> Const KeyConfig ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const KeyConfig Config)
-> ChatResources -> Const KeyConfig ChatResources)
-> ((KeyConfig -> Const KeyConfig KeyConfig)
-> Config -> Const KeyConfig Config)
-> (KeyConfig -> Const KeyConfig KeyConfig)
-> ChatResources
-> Const KeyConfig ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeyConfig -> Const KeyConfig KeyConfig)
-> Config -> Const KeyConfig Config
Lens' Config KeyConfig
configUserKeysL
KeyHandlerMap Map Event KeyHandler
keymap = KeyConfig -> KeyHandlerMap
mkBindingsMap KeyConfig
keyconf
in Text -> [Text] -> Text
T.intercalate Text
","
[ Binding -> Text
ppBinding (Event -> Binding
eventToBinding Event
k)
| KH { khKey :: KeyHandler -> Event
khKey = Event
k
, khHandler :: KeyHandler -> KeyEventHandler
khHandler = KeyEventHandler
h
} <- Map Event KeyHandler -> [KeyHandler]
forall k a. Map k a -> [a]
M.elems Map Event KeyHandler
keymap
, KeyEventHandler -> KeyEventTrigger
kehEventTrigger KeyEventHandler
h KeyEventTrigger -> KeyEventTrigger -> Bool
forall a. Eq a => a -> a -> Bool
== KeyEvent -> KeyEventTrigger
ByEvent KeyEvent
e
]