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 =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
defaultTimeFormat forall a. a -> a
id (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 Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configTimeFormatL)
getDateFormat :: ChatState -> Text
getDateFormat :: ChatState -> Text
getDateFormat ChatState
st =
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
defaultDateFormat forall a. a -> a
id (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 Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (Maybe Text)
configDateFormatL)
renderTime :: ChatState -> UTCTime -> Widget Name
renderTime :: ChatState -> UTCTime -> Widget Name
renderTime ChatState
st = forall a. Text -> TimeZoneSeries -> UTCTime -> Widget a
renderUTCTime (ChatState -> Text
getTimeFormat ChatState
st) (ChatState
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState TimeZoneSeries
timeZone)
renderDate :: ChatState -> UTCTime -> Widget Name
renderDate :: ChatState -> UTCTime -> Widget Name
renderDate ChatState
st = forall a. Text -> TimeZoneSeries -> UTCTime -> Widget a
renderUTCTime (ChatState -> Text
getDateFormat ChatState
st) (ChatState
stforall s a. s -> Getting a s a -> a
^.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 forall n. Widget n
emptyWidget
else forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
timeAttr (forall n. Text -> Widget n
txt forall a b. (a -> b) -> a -> b
$ Text -> LocalTime -> Text
localTimeText Text
fmt 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 = forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
clientEmphAttr forall a b. (a -> b) -> a -> b
$ forall n. Text -> Widget n
txt (Maybe Binding -> Text
ppMaybeBinding (forall k. (Show k, Ord k) => KeyConfig k -> k -> Maybe Binding
firstActiveBinding KeyConfig KeyEvent
kc KeyEvent
ev))
kc :: KeyConfig KeyEvent
kc = 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 Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' Config (KeyConfig KeyEvent)
configUserKeysL
in forall n. [Widget n] -> Widget n
hBox forall a b. (a -> b) -> a -> b
$ (forall a. a -> [a] -> [a]
intersperse (forall n. Text -> Widget n
txt Text
"/") forall a b. (a -> b) -> a -> b
$ forall {n}. KeyEvent -> Widget n
ppEv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyEvent]
evs) forall a. Semigroup a => a -> a -> a
<> [forall n. Text -> Widget n
txt (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 = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. MessageOps a => Message -> a -> a
addMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Message
dateMsg) Messages
ms Set UTCTime
dateRange
where dateRange :: Set UTCTime
dateRange = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Message -> Set UTCTime -> Set UTCTime
checkDateChange 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 (forall a. a -> Maybe a
Just TimeZoneSeries
tz) (ServerTime -> UTCTime
withServerTime (Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message ServerTime
mDate))
in if Message
mforall s a. s -> Getting a s a -> a
^.Lens' Message Bool
mDeleted then forall a. a -> a
id else 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 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 = forall n. [Widget n] -> Widget n
hBox [forall n. String -> Widget n
str String
"[", Widget a
w, forall n. String -> Widget n
str String
"]"]
userSigilFromInfo :: UserInfo -> Char
userSigilFromInfo :: UserInfo -> Char
userSigilFromInfo UserInfo
u = case UserInfo
uforall s a. s -> Getting a s a -> a
^.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
cforall s a. s -> Getting a s a -> a
^.Lens' ChannelInfo (Maybe UserId)
cdDMUserId forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a b c. (a -> b -> c) -> b -> a -> c
flip UserId -> ChatState -> Maybe UserInfo
userById ChatState
st of
Maybe UserInfo
Nothing -> ChannelInfo
cforall s a. s -> Getting a s a -> a
^.Lens' ChannelInfo Text
cdName
Just UserInfo
u -> UserInfo
uforall s a. s -> Getting a s a -> a
^.Lens' UserInfo Text
uiName
sigil :: Text
sigil = case ChannelInfo
cforall s a. s -> Getting a s a -> a
^.Lens' ChannelInfo Type
cdType of
Type
Private -> forall a. Monoid a => a
mempty
Type
Ordinary -> Text
normalChannelSigil
Type
Group -> forall a. Monoid a => a
mempty
Type
Direct -> Text
userSigil
Unknown 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
stforall s a. s -> Getting a s a -> a
^.Lens' ChatState ChatResources
csResourcesforall b c a. (b -> c) -> (a -> b) -> a -> c
.Lens' ChatResources Config
crConfigurationforall b c a. (b -> c) -> (a -> b) -> a -> c
.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
} <- forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k (m :: * -> *).
KeyDispatcher k m -> [(Binding, KeyHandler k m)]
keyDispatcherToList KeyDispatcher KeyEvent MH
keymap
, forall k (m :: * -> *). KeyEventHandler k m -> EventTrigger k
kehEventTrigger KeyEventHandler KeyEvent MH
h forall a. Eq a => a -> a -> Bool
== forall k. k -> EventTrigger k
ByEvent KeyEvent
e
]