matterhorn-50200.12.0: Terminal client for the Mattermost chat system
Safe HaskellNone
LanguageHaskell2010

Matterhorn.Types.RichText

Description

This module provides a set of data types to represent message text. The inline and block types in this module are designed to represent most of what is found in Markdown documents (particularly the Commonmark specification) in addition to other things we find in Mattermost messages, such as username or channel references.

To parse a Markdown document, use parseMarkdown. To actually render text in this representation, see the module RichText.

Synopsis

Documentation

newtype Blocks Source #

A sequence of rich text blocks.

Constructors

Blocks (Seq Block) 

data Block Source #

A block in a rich text document.

NOTE: update sameBlockType when constructors are added to this type.

Constructors

Para Inlines

A paragraph.

Header Int Inlines

A section header with specified depth and contents.

Blockquote Blocks

A blockquote.

List ListType ListSpacing (Seq Blocks)

An itemized list.

CodeBlock CodeBlockInfo Text

A code block.

HTMLBlock Text

A fragment of raw HTML.

HRule

A horizontal rule.

Instances

Instances details
Show Block Source # 
Instance details

Defined in Matterhorn.Types.RichText

Methods

showsPrec :: Int -> Block -> ShowS #

show :: Block -> String #

showList :: [Block] -> ShowS #

sameBlockType :: Block -> Block -> Bool Source #

Returns whether two blocks have the same type.

data CodeBlockInfo Source #

Information about a code block.

Constructors

CodeBlockInfo 

Fields

  • codeBlockLanguage :: Maybe Text

    The language of the source code in the code block, if any. This is encoded in Markdown as a sequence of non-whitespace characters following the fenced code block opening backticks.

  • codeBlockInfo :: Maybe Text

    Any text that comes after the language token. This text is separated from the language token by whitespace.

data Inline Source #

The kinds of inline values that can appear in rich text blocks.

Constructors

EText Text

Plain text that SHOULD be a contiguous sequence of non-whitespace characters.

EEmph Inlines

Emphasized (usually italicized) content.

EStrikethrough Inlines

Strikethrough content.

EStrong Inlines

Boldface content.

ECode Inlines

A sequence of non-whitespace characters.

ESpace

A single space.

ESoftBreak

A soft line break.

ELineBreak

A hard line break.

ERawHtml Text

Raw HTML.

EEditSentinel Bool

A sentinel indicating that some text has been edited (used to indicate that mattermost messages have been edited by their authors). This has no parsable representation; it is only used to annotate a message prior to rendering to add a visual editing indicator. The boolean indicates whether the edit was "recent" (True) or not (False).

EUser Text

A user reference. The text here includes only the username, not the sigil.

EChannel Text

A channel reference. The text here includes only the channel name, not the sigil.

EHyperlink URL Inlines

A hyperlink to the specified URL. Optionally provides an element sequence indicating the URL's text label; if absent, the label is understood to be the URL itself.

EImage URL Inlines

An image at the specified URL. Optionally provides an element sequence indicating the image's "alt" text label; if absent, the label is understood to be the URL itself.

EEmoji Text

An emoji reference. The text here includes only the text portion, not the colons, e.g. "foo" instead of ":foo:".

ENonBreaking Inlines

A sequence of elements that must never be separated during line wrapping.

EPermalink TeamURLName PostId (Maybe Inlines)

A permalink to the specified team (name) and post ID with an optional label.

Instances

Instances details
Eq Inline Source # 
Instance details

Defined in Matterhorn.Types.RichText

Methods

(==) :: Inline -> Inline -> Bool #

(/=) :: Inline -> Inline -> Bool #

Ord Inline Source # 
Instance details

Defined in Matterhorn.Types.RichText

Show Inline Source # 
Instance details

Defined in Matterhorn.Types.RichText

newtype Inlines Source #

A sequence of inline values.

Constructors

Inlines (Seq Inline) 

Instances

Instances details
Eq Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

Methods

(==) :: Inlines -> Inlines -> Bool #

(/=) :: Inlines -> Inlines -> Bool #

Ord Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

Show Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

Semigroup Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

Monoid Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

IsInline Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

Rangeable Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

HasAttributes Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

HasStrikethrough Inlines Source # 
Instance details

Defined in Matterhorn.Types.RichText

IsBlock Inlines Blocks Source # 
Instance details

Defined in Matterhorn.Types.RichText

data ListType #

Instances

Instances details
Eq ListType 
Instance details

Defined in Commonmark.Types

Data ListType 
Instance details

Defined in Commonmark.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ListType -> c ListType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ListType #

toConstr :: ListType -> Constr #

dataTypeOf :: ListType -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ListType) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListType) #

gmapT :: (forall b. Data b => b -> b) -> ListType -> ListType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ListType -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ListType -> r #

gmapQ :: (forall d. Data d => d -> u) -> ListType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ListType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ListType -> m ListType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ListType -> m ListType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ListType -> m ListType #

Ord ListType 
Instance details

Defined in Commonmark.Types

Show ListType 
Instance details

Defined in Commonmark.Types

data ListSpacing #

Constructors

TightList 
LooseList 

Instances

Instances details
Eq ListSpacing 
Instance details

Defined in Commonmark.Types

Data ListSpacing 
Instance details

Defined in Commonmark.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ListSpacing -> c ListSpacing #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ListSpacing #

toConstr :: ListSpacing -> Constr #

dataTypeOf :: ListSpacing -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ListSpacing) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ListSpacing) #

gmapT :: (forall b. Data b => b -> b) -> ListSpacing -> ListSpacing #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ListSpacing -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ListSpacing -> r #

gmapQ :: (forall d. Data d => d -> u) -> ListSpacing -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ListSpacing -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ListSpacing -> m ListSpacing #

Ord ListSpacing 
Instance details

Defined in Commonmark.Types

Show ListSpacing 
Instance details

Defined in Commonmark.Types

data EnumeratorType #

Instances

Instances details
Eq EnumeratorType 
Instance details

Defined in Commonmark.Types

Data EnumeratorType 
Instance details

Defined in Commonmark.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> EnumeratorType -> c EnumeratorType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c EnumeratorType #

toConstr :: EnumeratorType -> Constr #

dataTypeOf :: EnumeratorType -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c EnumeratorType) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EnumeratorType) #

gmapT :: (forall b. Data b => b -> b) -> EnumeratorType -> EnumeratorType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> EnumeratorType -> r #

gmapQ :: (forall d. Data d => d -> u) -> EnumeratorType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> EnumeratorType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> EnumeratorType -> m EnumeratorType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> EnumeratorType -> m EnumeratorType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> EnumeratorType -> m EnumeratorType #

Ord EnumeratorType 
Instance details

Defined in Commonmark.Types

Show EnumeratorType 
Instance details

Defined in Commonmark.Types

data DelimiterType #

Constructors

Period 
OneParen 
TwoParens 

Instances

Instances details
Eq DelimiterType 
Instance details

Defined in Commonmark.Types

Data DelimiterType 
Instance details

Defined in Commonmark.Types

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DelimiterType -> c DelimiterType #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DelimiterType #

toConstr :: DelimiterType -> Constr #

dataTypeOf :: DelimiterType -> DataType #

dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c DelimiterType) #

dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DelimiterType) #

gmapT :: (forall b. Data b => b -> b) -> DelimiterType -> DelimiterType #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DelimiterType -> r #

gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DelimiterType -> r #

gmapQ :: (forall d. Data d => d -> u) -> DelimiterType -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> DelimiterType -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DelimiterType -> m DelimiterType #

Ord DelimiterType 
Instance details

Defined in Commonmark.Types

Show DelimiterType 
Instance details

Defined in Commonmark.Types

data TeamBaseURL Source #

A server base URL with a team name.

Instances

Instances details
Eq TeamBaseURL Source # 
Instance details

Defined in Matterhorn.Types.RichText

Show TeamBaseURL Source # 
Instance details

Defined in Matterhorn.Types.RichText

data TeamURLName Source #

A team name found in a Mattermost post URL

Constructors

TeamURLName Text 

newtype URL Source #

A URL.

Constructors

URL Text 

Instances

Instances details
Eq URL Source # 
Instance details

Defined in Matterhorn.Types.RichText

Methods

(==) :: URL -> URL -> Bool #

(/=) :: URL -> URL -> Bool #

Ord URL Source # 
Instance details

Defined in Matterhorn.Types.RichText

Methods

compare :: URL -> URL -> Ordering #

(<) :: URL -> URL -> Bool #

(<=) :: URL -> URL -> Bool #

(>) :: URL -> URL -> Bool #

(>=) :: URL -> URL -> Bool #

max :: URL -> URL -> URL #

min :: URL -> URL -> URL #

Show URL Source # 
Instance details

Defined in Matterhorn.Types.RichText

Methods

showsPrec :: Int -> URL -> ShowS #

show :: URL -> String #

showList :: [URL] -> ShowS #

parseMarkdown Source #

Arguments

:: Maybe TeamBaseURL

If provided, perform post link detection whenever a hyperlink is parsed by checking to see if the post link is a post in this Mattermost team

-> Text

The markdown input text to parse

-> Blocks 

Parse markdown input text to RichText.

Note that this always returns a block sequence even if the input cannot be parsed. It isn't yet clear just how permissive the commonmark parser is, but so far we have not encountered any issues. If the input document is so broken that commonmark cannot parse it, we return an empty block sequence.

findUsernames :: Blocks -> Set Text Source #

Obtain all username references in a rich text document.

blockGetURLs :: Block -> [(Either (TeamURLName, PostId) URL, Maybe Inlines)] Source #

Obtain all URLs (and optional labels) in a rich text block.

findVerbatimChunk :: Blocks -> Maybe Text Source #

Find the first code block in a sequence of rich text blocks.