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)]

-- | Modifies a message sequence by inserting date transition markers
-- in between messages with different creation dates. Server dates from
-- messages are converted to local time (via the current timezone)
-- and midnight of that timezone used to generate date markers.
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

-- | Resolve the specified key event into a pretty-printed
-- representation of the active bindings for that event, using the
-- specified key handler map builder. If the event has more than one
-- active binding, the bindings are comma-delimited in the resulting
-- string.
keyEventBindings :: ChatState
                 -- ^ The current application state
                 -> (KeyConfig -> KeyHandlerMap)
                 -- ^ The function to obtain the relevant key handler
                 -- map
                 -> KeyEvent
                 -- ^ The key event to look up
                 -> 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
         ]