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

-- | 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 = 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

-- | 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 KeyEvent -> KeyDispatcher KeyEvent MH)
                 -- ^ The function to obtain the relevant key handler
                 -- map
                 -> KeyEvent
                 -- ^ The key event to look up
                 -> 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
         ]