module Matterhorn.Draw.URLList
  ( renderUrlList
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick
import           Brick.Widgets.Border ( hBorder )
import           Brick.Widgets.List ( renderList )
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import           Lens.Micro.Platform ( to )

import           Network.Mattermost.Types ( ServerTime(..), idString )

import           Matterhorn.Draw.Messages
import           Matterhorn.Draw.Util
import           Matterhorn.Draw.RichText
import           Matterhorn.Themes
import           Matterhorn.Types
import           Matterhorn.Types.RichText


renderUrlList :: ChatState -> Widget Name
renderUrlList :: ChatState -> Widget Name
renderUrlList ChatState
st =
    Widget Name
header Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
urlDisplay
    where
        header :: Widget Name
header = (AttrName -> Widget Name -> Widget Name
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
channelHeaderAttr (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
                 (Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe Name)
-> Text
-> Widget Name
forall a.
SemEq a =>
Maybe TeamBaseURL
-> Text
-> HighlightSet
-> Maybe (Int -> Inline -> Maybe a)
-> Text
-> Widget a
renderText' Maybe TeamBaseURL
forall a. Maybe a
Nothing Text
"" (ChatState -> HighlightSet
getHighlightSet ChatState
st) Maybe (Int -> Inline -> Maybe Name)
forall a. Maybe a
Nothing (Text -> Widget Name) -> Text -> Widget Name
forall a b. (a -> b) -> a -> b
$
                  Text
"URLs: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ChatState -> ChannelInfo -> Text
mkChannelName ChatState
st (ChatState
stChatState
-> Getting ChannelInfo ChatState ChannelInfo -> ChannelInfo
forall s a. s -> Getting a s a -> a
^.(ClientChannel -> Const ChannelInfo ClientChannel)
-> ChatState -> Const ChannelInfo ChatState
Lens' ChatState ClientChannel
csCurrentChannel((ClientChannel -> Const ChannelInfo ClientChannel)
 -> ChatState -> Const ChannelInfo ChatState)
-> ((ChannelInfo -> Const ChannelInfo ChannelInfo)
    -> ClientChannel -> Const ChannelInfo ClientChannel)
-> Getting ChannelInfo ChatState ChannelInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(ChannelInfo -> Const ChannelInfo ChannelInfo)
-> ClientChannel -> Const ChannelInfo ClientChannel
Lens' ClientChannel ChannelInfo
ccInfo))) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+>
                 Char -> Widget Name
forall n. Char -> Widget n
fill Char
' ') Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=> Widget Name
forall n. Widget n
hBorder

        urlDisplay :: Widget Name
urlDisplay = if GenericList Name Vector (Int, LinkChoice) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
F.length GenericList Name Vector (Int, LinkChoice)
urls Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                     then String -> Widget Name
forall n. String -> Widget n
str String
"No URLs found in this channel."
                     else (Bool -> (Int, LinkChoice) -> Widget Name)
-> Bool -> GenericList Name Vector (Int, LinkChoice) -> Widget Name
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> (Int, LinkChoice) -> Widget Name
renderItem Bool
True GenericList Name Vector (Int, LinkChoice)
urls

        urls :: GenericList Name Vector (Int, LinkChoice)
urls = ChatState
stChatState
-> Getting
     (GenericList Name Vector (Int, LinkChoice))
     ChatState
     (GenericList Name Vector (Int, LinkChoice))
-> GenericList Name Vector (Int, LinkChoice)
forall s a. s -> Getting a s a -> a
^.(TeamState
 -> Const (GenericList Name Vector (Int, LinkChoice)) TeamState)
-> ChatState
-> Const (GenericList Name Vector (Int, LinkChoice)) ChatState
Lens' ChatState TeamState
csCurrentTeam((TeamState
  -> Const (GenericList Name Vector (Int, LinkChoice)) TeamState)
 -> ChatState
 -> Const (GenericList Name Vector (Int, LinkChoice)) ChatState)
-> ((GenericList Name Vector (Int, LinkChoice)
     -> Const
          (GenericList Name Vector (Int, LinkChoice))
          (GenericList Name Vector (Int, LinkChoice)))
    -> TeamState
    -> Const (GenericList Name Vector (Int, LinkChoice)) TeamState)
-> Getting
     (GenericList Name Vector (Int, LinkChoice))
     ChatState
     (GenericList Name Vector (Int, LinkChoice))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(GenericList Name Vector (Int, LinkChoice)
 -> Const
      (GenericList Name Vector (Int, LinkChoice))
      (GenericList Name Vector (Int, LinkChoice)))
-> TeamState
-> Const (GenericList Name Vector (Int, LinkChoice)) TeamState
Lens' TeamState (GenericList Name Vector (Int, LinkChoice))
tsUrlList

        me :: Text
me = ChatState -> Text
myUsername ChatState
st

        hSet :: HighlightSet
hSet = ChatState -> HighlightSet
getHighlightSet ChatState
st

        renderItem :: Bool -> (Int, LinkChoice) -> Widget Name
renderItem Bool
sel (Int
i, LinkChoice
link) =
          let time :: ServerTime
time = LinkChoice
linkLinkChoice
-> Getting ServerTime LinkChoice ServerTime -> ServerTime
forall s a. s -> Getting a s a -> a
^.Getting ServerTime LinkChoice ServerTime
Lens' LinkChoice ServerTime
linkTime
          in Bool -> Widget Name -> Widget Name
forall n. Bool -> Widget n -> Widget n
attr Bool
sel (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
2 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
            (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$
             [Widget Name] -> Widget Name
forall n. [Widget n] -> Widget n
hBox [ let u :: Text
u = Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"<server>" Text -> Text
forall a. a -> a
id (LinkChoice
linkLinkChoice
-> Getting (Maybe Text) LinkChoice (Maybe Text) -> Maybe Text
forall s a. s -> Getting a s a -> a
^.(UserRef -> Const (Maybe Text) UserRef)
-> LinkChoice -> Const (Maybe Text) LinkChoice
Lens' LinkChoice UserRef
linkUser((UserRef -> Const (Maybe Text) UserRef)
 -> LinkChoice -> Const (Maybe Text) LinkChoice)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UserRef -> Const (Maybe Text) UserRef)
-> Getting (Maybe Text) LinkChoice (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(UserRef -> Maybe Text) -> SimpleGetter UserRef (Maybe Text)
forall s a. (s -> a) -> SimpleGetter s a
to (ChatState -> UserRef -> Maybe Text
printableNameForUserRef ChatState
st))
                    in Text -> Text -> Text -> Widget Name
forall a. Text -> Text -> Text -> Widget a
colorUsername Text
me Text
u Text
u
                  , case LinkChoice
linkLinkChoice
-> Getting (Maybe Inlines) LinkChoice (Maybe Inlines)
-> Maybe Inlines
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Inlines) LinkChoice (Maybe Inlines)
Lens' LinkChoice (Maybe Inlines)
linkLabel of
                      Maybe Inlines
Nothing -> Widget Name
forall n. Widget n
emptyWidget
                      Just Inlines
label ->
                          case Seq Inline -> Bool
forall a. Seq a -> Bool
Seq.null (Inlines -> Seq Inline
unInlines Inlines
label) of
                              Bool
True -> Widget Name
forall n. Widget n
emptyWidget
                              Bool
False -> Text -> Widget Name
forall n. Text -> Widget n
txt Text
": " Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<+> Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe Name)
-> Blocks
-> Widget Name
forall a.
SemEq a =>
Text
-> HighlightSet
-> Maybe Int
-> Bool
-> Maybe Int
-> Maybe (Int -> Inline -> Maybe a)
-> Blocks
-> Widget a
renderRichText Text
me HighlightSet
hSet Maybe Int
forall a. Maybe a
Nothing Bool
False Maybe Int
forall a. Maybe a
Nothing Maybe (Int -> Inline -> Maybe Name)
forall a. Maybe a
Nothing
                                                    (Seq Block -> Blocks
Blocks (Seq Block -> Blocks) -> Seq Block -> Blocks
forall a b. (a -> b) -> a -> b
$ Block -> Seq Block
forall a. a -> Seq a
Seq.singleton (Block -> Seq Block) -> Block -> Seq Block
forall a b. (a -> b) -> a -> b
$ Inlines -> Block
Para Inlines
label)
                  , Char -> Widget Name
forall n. Char -> Widget n
fill Char
' '
                  , ChatState -> UTCTime -> Widget Name
renderDate ChatState
st (UTCTime -> Widget Name) -> UTCTime -> Widget Name
forall a b. (a -> b) -> a -> b
$ ServerTime -> UTCTime
withServerTime ServerTime
time
                  , String -> Widget Name
forall n. String -> Widget n
str String
" "
                  , ChatState -> UTCTime -> Widget Name
renderTime ChatState
st (UTCTime -> Widget Name) -> UTCTime -> Widget Name
forall a b. (a -> b) -> a -> b
$ ServerTime -> UTCTime
withServerTime ServerTime
time
                  ] ) Widget Name -> Widget Name -> Widget Name
forall n. Widget n -> Widget n -> Widget n
<=>
            (Int -> Widget Name -> Widget Name
forall n. Int -> Widget n -> Widget n
vLimit Int
1 (Name -> Widget Name -> Widget Name
forall n. n -> Widget n -> Widget n
clickable (Int -> LinkTarget -> Name
ClickableURLListEntry Int
i (LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget)) (Widget Name -> Widget Name) -> Widget Name -> Widget Name
forall a b. (a -> b) -> a -> b
$ LinkTarget -> Widget Name
forall a. SemEq a => LinkTarget -> Widget a
renderLinkTarget (LinkChoice
linkLinkChoice
-> Getting LinkTarget LinkChoice LinkTarget -> LinkTarget
forall s a. s -> Getting a s a -> a
^.Getting LinkTarget LinkChoice LinkTarget
Lens' LinkChoice LinkTarget
linkTarget)))

        renderLinkTarget :: LinkTarget -> Widget a
renderLinkTarget (LinkPermalink (TeamURLName Text
tName) PostId
pId) =
            Text -> Widget a
forall a. SemEq a => Text -> Widget a
renderText (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ Text
"Team: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
", post " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PostId -> Text
forall x. IsId x => x -> Text
idString PostId
pId
        renderLinkTarget (LinkURL URL
url) = Text -> Widget a
forall a. SemEq a => Text -> Widget a
renderText (Text -> Widget a) -> Text -> Widget a
forall a b. (a -> b) -> a -> b
$ URL -> Text
unURL URL
url
        renderLinkTarget (LinkFileId FileId
_) = Text -> Widget a
forall n. Text -> Widget n
txt Text
" "

        attr :: Bool -> Widget n -> Widget n
attr Bool
True = AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
forceAttr AttrName
urlListSelectedAttr
        attr Bool
False = Widget n -> Widget n
forall a. a -> a
id