module Matterhorn.Draw.Util
( withBrackets
, renderTime
, renderDate
, renderKeybindingHelp
, insertDateMarkers
, getDateFormat
, mkChannelName
, userSigilFromInfo
, multilineHeightLimit
, keyEventBindings
)
where
import Prelude ()
import Matterhorn.Prelude
import Brick
import Brick.Keybindings
import Data.List ( intersperse )
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
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 :: forall a. 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 (Maybe Binding -> Text
ppMaybeBinding (KeyConfig KeyEvent -> KeyEvent -> Maybe Binding
forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
ev))
kc :: KeyConfig KeyEvent
kc = ChatState
stChatState
-> Getting (KeyConfig KeyEvent) ChatState (KeyConfig KeyEvent)
-> KeyConfig KeyEvent
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> ChatState -> Const (KeyConfig KeyEvent) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> ChatState -> Const (KeyConfig KeyEvent) ChatState)
-> ((KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> Getting (KeyConfig KeyEvent) ChatState (KeyConfig KeyEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (KeyConfig KeyEvent) Config)
-> ChatResources -> Const (KeyConfig KeyEvent) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (KeyConfig KeyEvent) Config)
-> ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> ((KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> Config -> Const (KeyConfig KeyEvent) Config)
-> (KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> ChatResources
-> Const (KeyConfig KeyEvent) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> Config -> Const (KeyConfig KeyEvent) Config
Lens' Config (KeyConfig KeyEvent)
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 a b. (a -> b -> b) -> b -> Set a -> b
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 a b.
(a -> b -> b) -> b -> DirectionalSeq Chronological a -> b
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 :: forall a. 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 a b. Maybe a -> (a -> Maybe b) -> Maybe b
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 KeyEvent -> KeyDispatcher KeyEvent MH)
-> KeyEvent
-> T.Text
keyEventBindings :: ChatState
-> (KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH)
-> KeyEvent
-> Text
keyEventBindings ChatState
st KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
mkBindingsMap KeyEvent
e =
let keyconf :: KeyConfig KeyEvent
keyconf = ChatState
stChatState
-> Getting (KeyConfig KeyEvent) ChatState (KeyConfig KeyEvent)
-> KeyConfig KeyEvent
forall s a. s -> Getting a s a -> a
^.(ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> ChatState -> Const (KeyConfig KeyEvent) ChatState
Lens' ChatState ChatResources
csResources((ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> ChatState -> Const (KeyConfig KeyEvent) ChatState)
-> ((KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> Getting (KeyConfig KeyEvent) ChatState (KeyConfig KeyEvent)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Config -> Const (KeyConfig KeyEvent) Config)
-> ChatResources -> Const (KeyConfig KeyEvent) ChatResources
Lens' ChatResources Config
crConfiguration((Config -> Const (KeyConfig KeyEvent) Config)
-> ChatResources -> Const (KeyConfig KeyEvent) ChatResources)
-> ((KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> Config -> Const (KeyConfig KeyEvent) Config)
-> (KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> ChatResources
-> Const (KeyConfig KeyEvent) ChatResources
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(KeyConfig KeyEvent
-> Const (KeyConfig KeyEvent) (KeyConfig KeyEvent))
-> Config -> Const (KeyConfig KeyEvent) Config
Lens' Config (KeyConfig KeyEvent)
configUserKeysL
keymap :: KeyDispatcher KeyEvent MH
keymap = KeyConfig KeyEvent -> KeyDispatcher KeyEvent MH
mkBindingsMap KeyConfig KeyEvent
keyconf
in Text -> [Text] -> Text
T.intercalate Text
","
[ Binding -> Text
ppBinding Binding
b
| KeyHandler { khBinding :: forall k (m :: * -> *). KeyHandler k m -> Binding
khBinding = Binding
b
, khHandler :: forall k (m :: * -> *). KeyHandler k m -> KeyEventHandler k m
khHandler = KeyEventHandler KeyEvent MH
h
} <- (Binding, KeyHandler KeyEvent MH) -> KeyHandler KeyEvent MH
forall a b. (a, b) -> b
snd ((Binding, KeyHandler KeyEvent MH) -> KeyHandler KeyEvent MH)
-> [(Binding, KeyHandler KeyEvent MH)] -> [KeyHandler KeyEvent MH]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyDispatcher KeyEvent MH -> [(Binding, KeyHandler KeyEvent MH)]
forall k (m :: * -> *).
KeyDispatcher k m -> [(Binding, KeyHandler k m)]
keyDispatcherToList KeyDispatcher KeyEvent MH
keymap
, KeyEventHandler KeyEvent MH -> EventTrigger KeyEvent
forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k
kehEventTrigger KeyEventHandler KeyEvent MH
h EventTrigger KeyEvent -> EventTrigger KeyEvent -> Bool
forall a. Eq a => a -> a -> Bool
== KeyEvent -> EventTrigger KeyEvent
forall k. k -> EventTrigger k
ByEvent KeyEvent
e
]