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